summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog.104
-rw-r--r--lisp/ChangeLog.112
-rw-r--r--lisp/ChangeLog.124
-rw-r--r--lisp/ChangeLog.134
-rw-r--r--lisp/ChangeLog.144
-rw-r--r--lisp/ChangeLog.1514
-rw-r--r--lisp/ChangeLog.1626
-rw-r--r--lisp/ChangeLog.1720
-rw-r--r--lisp/ChangeLog.32
-rw-r--r--lisp/ChangeLog.62
-rw-r--r--lisp/ChangeLog.76
-rw-r--r--lisp/ChangeLog.84
-rw-r--r--lisp/ChangeLog.910
-rw-r--r--lisp/Makefile.in1
-rw-r--r--lisp/abbrev.el188
-rw-r--r--lisp/align.el13
-rw-r--r--lisp/allout-widgets.el213
-rw-r--r--lisp/allout.el470
-rw-r--r--lisp/ansi-color.el66
-rw-r--r--lisp/apropos.el128
-rw-r--r--lisp/arc-mode.el1176
-rw-r--r--lisp/auth-source.el4
-rw-r--r--lisp/autoarg.el7
-rw-r--r--lisp/autoinsert.el5
-rw-r--r--lisp/autorevert.el114
-rw-r--r--lisp/battery.el670
-rw-r--r--lisp/bindings.el97
-rw-r--r--lisp/bookmark.el373
-rw-r--r--lisp/bs.el7
-rw-r--r--lisp/buff-menu.el63
-rw-r--r--lisp/button.el91
-rw-r--r--lisp/calc/calc-aent.el20
-rw-r--r--lisp/calc/calc-arith.el81
-rw-r--r--lisp/calc/calc-bin.el38
-rw-r--r--lisp/calc/calc-comb.el60
-rw-r--r--lisp/calc/calc-cplx.el2
-rw-r--r--lisp/calc/calc-embed.el56
-rw-r--r--lisp/calc/calc-ext.el79
-rw-r--r--lisp/calc/calc-fin.el2
-rw-r--r--lisp/calc/calc-forms.el82
-rw-r--r--lisp/calc/calc-frac.el2
-rw-r--r--lisp/calc/calc-funcs.el16
-rw-r--r--lisp/calc/calc-graph.el45
-rw-r--r--lisp/calc/calc-help.el40
-rw-r--r--lisp/calc/calc-incom.el2
-rw-r--r--lisp/calc/calc-keypd.el84
-rw-r--r--lisp/calc/calc-lang.el60
-rw-r--r--lisp/calc/calc-macs.el1
-rw-r--r--lisp/calc/calc-map.el48
-rw-r--r--lisp/calc/calc-math.el86
-rw-r--r--lisp/calc/calc-menu.el2
-rw-r--r--lisp/calc/calc-misc.el27
-rw-r--r--lisp/calc/calc-mode.el6
-rw-r--r--lisp/calc/calc-mtx.el4
-rw-r--r--lisp/calc/calc-nlfit.el96
-rw-r--r--lisp/calc/calc-prog.el30
-rw-r--r--lisp/calc/calc-rewr.el44
-rw-r--r--lisp/calc/calc-rules.el2
-rw-r--r--lisp/calc/calc-sel.el20
-rw-r--r--lisp/calc/calc-stat.el2
-rw-r--r--lisp/calc/calc-store.el19
-rw-r--r--lisp/calc/calc-stuff.el7
-rw-r--r--lisp/calc/calc-trail.el2
-rw-r--r--lisp/calc/calc-undo.el2
-rw-r--r--lisp/calc/calc-units.el8
-rw-r--r--lisp/calc/calc-vec.el31
-rw-r--r--lisp/calc/calc-yank.el62
-rw-r--r--lisp/calc/calc.el123
-rw-r--r--lisp/calc/calcalg2.el685
-rw-r--r--lisp/calc/calcalg3.el75
-rw-r--r--lisp/calc/calccomp.el3
-rw-r--r--lisp/calc/calcsel2.el3
-rw-r--r--lisp/calculator.el12
-rw-r--r--lisp/calendar/cal-bahai.el4
-rw-r--r--lisp/calendar/cal-dst.el18
-rw-r--r--lisp/calendar/cal-julian.el22
-rw-r--r--lisp/calendar/calendar.el24
-rw-r--r--lisp/calendar/diary-lib.el29
-rw-r--r--lisp/calendar/icalendar.el59
-rw-r--r--lisp/calendar/iso8601.el17
-rw-r--r--lisp/calendar/lunar.el44
-rw-r--r--lisp/calendar/parse-time.el98
-rw-r--r--lisp/calendar/solar.el14
-rw-r--r--lisp/calendar/time-date.el80
-rw-r--r--lisp/calendar/timeclock.el12
-rw-r--r--lisp/calendar/todo-mode.el97
-rw-r--r--lisp/case-table.el40
-rw-r--r--lisp/cdl.el2
-rw-r--r--lisp/cedet/ChangeLog.14
-rw-r--r--lisp/cedet/data-debug.el42
-rw-r--r--lisp/cedet/ede.el16
-rw-r--r--lisp/cedet/ede/cpp-root.el15
-rw-r--r--lisp/cedet/ede/detect.el10
-rw-r--r--lisp/cedet/ede/emacs.el27
-rw-r--r--lisp/cedet/ede/files.el37
-rw-r--r--lisp/cedet/ede/make.el24
-rw-r--r--lisp/cedet/ede/pconf.el5
-rw-r--r--lisp/cedet/ede/proj-elisp.el15
-rw-r--r--lisp/cedet/semantic.el81
-rw-r--r--lisp/cedet/semantic/bovine/c.el25
-rw-r--r--lisp/cedet/semantic/bovine/el.el3
-rw-r--r--lisp/cedet/semantic/bovine/grammar.el3
-rw-r--r--lisp/cedet/semantic/bovine/scm.el2
-rw-r--r--lisp/cedet/semantic/complete.el8
-rw-r--r--lisp/cedet/semantic/db-ebrowse.el5
-rw-r--r--lisp/cedet/semantic/db-find.el4
-rw-r--r--lisp/cedet/semantic/db-mode.el4
-rw-r--r--lisp/cedet/semantic/db.el4
-rw-r--r--lisp/cedet/semantic/decorate/mode.el3
-rw-r--r--lisp/cedet/semantic/dep.el18
-rw-r--r--lisp/cedet/semantic/doc.el3
-rw-r--r--lisp/cedet/semantic/ede-grammar.el17
-rw-r--r--lisp/cedet/semantic/edit.el3
-rw-r--r--lisp/cedet/semantic/fw.el23
-rw-r--r--lisp/cedet/semantic/grammar.el50
-rw-r--r--lisp/cedet/semantic/idle.el9
-rw-r--r--lisp/cedet/semantic/imenu.el11
-rw-r--r--lisp/cedet/semantic/java.el5
-rw-r--r--lisp/cedet/semantic/lex-spp.el4
-rw-r--r--lisp/cedet/semantic/lex.el238
-rw-r--r--lisp/cedet/semantic/symref/list.el10
-rw-r--r--lisp/cedet/semantic/tag-file.el13
-rw-r--r--lisp/cedet/semantic/tag-ls.el16
-rw-r--r--lisp/cedet/semantic/tag.el20
-rw-r--r--lisp/cedet/semantic/util.el7
-rw-r--r--lisp/cedet/semantic/wisent.el5
-rw-r--r--lisp/cedet/semantic/wisent/comp.el4
-rw-r--r--lisp/cedet/semantic/wisent/grammar.el2
-rw-r--r--lisp/cedet/semantic/wisent/wisent.el9
-rw-r--r--lisp/cedet/srecode.el2
-rw-r--r--lisp/cedet/srecode/document.el14
-rw-r--r--lisp/cedet/srecode/fields.el2
-rw-r--r--lisp/cedet/srecode/semantic.el2
-rw-r--r--lisp/cedet/srecode/srt-mode.el2
-rw-r--r--lisp/char-fold.el13
-rw-r--r--lisp/cmuscheme.el7
-rw-r--r--lisp/comint.el71
-rw-r--r--lisp/completion.el129
-rw-r--r--lisp/composite.el15
-rw-r--r--lisp/cus-dep.el42
-rw-r--r--lisp/cus-edit.el618
-rw-r--r--lisp/cus-face.el16
-rw-r--r--lisp/cus-start.el20
-rw-r--r--lisp/cus-theme.el17
-rw-r--r--lisp/custom.el65
-rw-r--r--lisp/delim-col.el2
-rw-r--r--lisp/delsel.el4
-rw-r--r--lisp/descr-text.el52
-rw-r--r--lisp/desktop.el4
-rw-r--r--lisp/dframe.el4
-rw-r--r--lisp/dired-aux.el356
-rw-r--r--lisp/dired-x.el110
-rw-r--r--lisp/dired.el501
-rw-r--r--lisp/dirtrack.el3
-rw-r--r--lisp/disp-table.el2
-rw-r--r--lisp/display-fill-column-indicator.el16
-rw-r--r--lisp/dnd.el50
-rw-r--r--lisp/doc-view.el133
-rw-r--r--lisp/dom.el50
-rw-r--r--lisp/dos-vars.el6
-rw-r--r--lisp/double.el2
-rw-r--r--lisp/edmacro.el1
-rw-r--r--lisp/ehelp.el5
-rw-r--r--lisp/elide-head.el12
-rw-r--r--lisp/emacs-lisp/advice.el42
-rw-r--r--lisp/emacs-lisp/autoload.el164
-rw-r--r--lisp/emacs-lisp/backquote.el2
-rw-r--r--lisp/emacs-lisp/benchmark.el2
-rw-r--r--lisp/emacs-lisp/bindat.el11
-rw-r--r--lisp/emacs-lisp/byte-opt.el422
-rw-r--r--lisp/emacs-lisp/byte-run.el170
-rw-r--r--lisp/emacs-lisp/bytecomp.el359
-rw-r--r--lisp/emacs-lisp/cconv.el34
-rw-r--r--lisp/emacs-lisp/chart.el6
-rw-r--r--lisp/emacs-lisp/check-declare.el5
-rw-r--r--lisp/emacs-lisp/checkdoc.el24
-rw-r--r--lisp/emacs-lisp/cl-extra.el17
-rw-r--r--lisp/emacs-lisp/cl-generic.el16
-rw-r--r--lisp/emacs-lisp/cl-indent.el36
-rw-r--r--lisp/emacs-lisp/cl-lib.el8
-rw-r--r--lisp/emacs-lisp/cl-macs.el215
-rw-r--r--lisp/emacs-lisp/cl-seq.el2
-rw-r--r--lisp/emacs-lisp/copyright.el9
-rw-r--r--lisp/emacs-lisp/crm.el6
-rw-r--r--lisp/emacs-lisp/debug.el7
-rw-r--r--lisp/emacs-lisp/derived.el1
-rw-r--r--lisp/emacs-lisp/disass.el5
-rw-r--r--lisp/emacs-lisp/easy-mmode.el146
-rw-r--r--lisp/emacs-lisp/easymenu.el10
-rw-r--r--lisp/emacs-lisp/edebug.el184
-rw-r--r--lisp/emacs-lisp/eieio-base.el259
-rw-r--r--lisp/emacs-lisp/eieio-core.el4
-rw-r--r--lisp/emacs-lisp/eieio-opt.el9
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el6
-rw-r--r--lisp/emacs-lisp/eieio.el42
-rw-r--r--lisp/emacs-lisp/eldoc.el748
-rw-r--r--lisp/emacs-lisp/elp.el6
-rw-r--r--lisp/emacs-lisp/ert-x.el53
-rw-r--r--lisp/emacs-lisp/ert.el20
-rw-r--r--lisp/emacs-lisp/ewoc.el48
-rw-r--r--lisp/emacs-lisp/find-func.el30
-rw-r--r--lisp/emacs-lisp/float-sup.el2
-rw-r--r--lisp/emacs-lisp/generator.el10
-rw-r--r--lisp/emacs-lisp/generic.el4
-rw-r--r--lisp/emacs-lisp/gv.el47
-rw-r--r--lisp/emacs-lisp/hierarchy.el579
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el13
-rw-r--r--lisp/emacs-lisp/lisp-mode.el51
-rw-r--r--lisp/emacs-lisp/lisp.el194
-rw-r--r--lisp/emacs-lisp/map.el17
-rw-r--r--lisp/emacs-lisp/nadvice.el8
-rw-r--r--lisp/emacs-lisp/package.el361
-rw-r--r--lisp/emacs-lisp/pcase.el58
-rw-r--r--lisp/emacs-lisp/pp.el7
-rw-r--r--lisp/emacs-lisp/re-builder.el4
-rw-r--r--lisp/emacs-lisp/regi.el2
-rw-r--r--lisp/emacs-lisp/rx.el2
-rw-r--r--lisp/emacs-lisp/seq.el5
-rw-r--r--lisp/emacs-lisp/shadow.el3
-rw-r--r--lisp/emacs-lisp/shortdoc.el1254
-rw-r--r--lisp/emacs-lisp/smie.el21
-rw-r--r--lisp/emacs-lisp/subr-x.el10
-rw-r--r--lisp/emacs-lisp/syntax.el97
-rw-r--r--lisp/emacs-lisp/tabulated-list.el40
-rw-r--r--lisp/emacs-lisp/tcover-unsafep.el140
-rw-r--r--lisp/emacs-lisp/text-property-search.el30
-rw-r--r--lisp/emacs-lisp/timer-list.el123
-rw-r--r--lisp/emacs-lisp/timer.el3
-rw-r--r--lisp/emacs-lisp/trace.el17
-rw-r--r--lisp/emacs-lisp/unsafep.el32
-rw-r--r--lisp/emacs-lisp/warnings.el45
-rw-r--r--lisp/emacs-lock.el11
-rw-r--r--lisp/emulation/cua-base.el9
-rw-r--r--lisp/emulation/cua-rect.el90
-rw-r--r--lisp/emulation/edt-lk201.el2
-rw-r--r--lisp/emulation/edt-mapper.el3
-rw-r--r--lisp/emulation/edt-pc.el2
-rw-r--r--lisp/emulation/edt-vt100.el2
-rw-r--r--lisp/emulation/edt.el4
-rw-r--r--lisp/emulation/viper-cmd.el60
-rw-r--r--lisp/emulation/viper-init.el2
-rw-r--r--lisp/emulation/viper-keym.el2
-rw-r--r--lisp/emulation/viper-mous.el52
-rw-r--r--lisp/emulation/viper-util.el21
-rw-r--r--lisp/emulation/viper.el36
-rw-r--r--lisp/epa-dired.el45
-rw-r--r--lisp/epa-file.el85
-rw-r--r--lisp/epa-hook.el12
-rw-r--r--lisp/epa-mail.el32
-rw-r--r--lisp/epa.el272
-rw-r--r--lisp/epg-config.el21
-rw-r--r--lisp/epg.el97
-rw-r--r--lisp/erc/ChangeLog.110
-rw-r--r--lisp/erc/erc-autoaway.el4
-rw-r--r--lisp/erc/erc-backend.el87
-rw-r--r--lisp/erc/erc-button.el4
-rw-r--r--lisp/erc/erc-capab.el16
-rw-r--r--lisp/erc/erc-dcc.el36
-rw-r--r--lisp/erc/erc-desktop-notifications.el11
-rw-r--r--lisp/erc/erc-ezbounce.el2
-rw-r--r--lisp/erc/erc-fill.el2
-rw-r--r--lisp/erc/erc-goodies.el30
-rw-r--r--lisp/erc/erc-ibuffer.el12
-rw-r--r--lisp/erc/erc-join.el26
-rw-r--r--lisp/erc/erc-list.el28
-rw-r--r--lisp/erc/erc-log.el4
-rw-r--r--lisp/erc/erc-match.el92
-rw-r--r--lisp/erc/erc-networks.el14
-rw-r--r--lisp/erc/erc-notify.el2
-rw-r--r--lisp/erc/erc-pcomplete.el1
-rw-r--r--lisp/erc/erc-speedbar.el5
-rw-r--r--lisp/erc/erc-stamp.el1
-rw-r--r--lisp/erc/erc-status-sidebar.el309
-rw-r--r--lisp/erc/erc-track.el12
-rw-r--r--lisp/erc/erc.el268
-rw-r--r--lisp/eshell/em-basic.el9
-rw-r--r--lisp/eshell/em-cmpl.el91
-rw-r--r--lisp/eshell/em-dirs.el10
-rw-r--r--lisp/eshell/em-glob.el4
-rw-r--r--lisp/eshell/em-hist.el123
-rw-r--r--lisp/eshell/em-ls.el76
-rw-r--r--lisp/eshell/em-pred.el97
-rw-r--r--lisp/eshell/em-prompt.el23
-rw-r--r--lisp/eshell/em-rebind.el14
-rw-r--r--lisp/eshell/em-smart.el25
-rw-r--r--lisp/eshell/em-unix.el55
-rw-r--r--lisp/eshell/em-xtra.el30
-rw-r--r--lisp/eshell/esh-arg.el95
-rw-r--r--lisp/eshell/esh-cmd.el30
-rw-r--r--lisp/eshell/esh-io.el7
-rw-r--r--lisp/eshell/esh-mode.el268
-rw-r--r--lisp/eshell/esh-module.el19
-rw-r--r--lisp/eshell/esh-proc.el40
-rw-r--r--lisp/eshell/esh-util.el65
-rw-r--r--lisp/eshell/esh-var.el77
-rw-r--r--lisp/eshell/eshell.el31
-rw-r--r--lisp/expand.el8
-rw-r--r--lisp/facemenu.el13
-rw-r--r--lisp/faces.el67
-rw-r--r--lisp/ffap.el200
-rw-r--r--lisp/filecache.el3
-rw-r--r--lisp/fileloop.el56
-rw-r--r--lisp/files-x.el19
-rw-r--r--lisp/files.el332
-rw-r--r--lisp/filesets.el4
-rw-r--r--lisp/find-dired.el16
-rw-r--r--lisp/find-file.el4
-rw-r--r--lisp/finder.el9
-rw-r--r--lisp/foldout.el25
-rw-r--r--lisp/font-lock.el58
-rw-r--r--lisp/format-spec.el183
-rw-r--r--lisp/format.el8
-rw-r--r--lisp/forms.el35
-rw-r--r--lisp/frame.el62
-rw-r--r--lisp/frameset.el12
-rw-r--r--lisp/generic-x.el2
-rw-r--r--lisp/gnus/ChangeLog.210
-rw-r--r--lisp/gnus/ChangeLog.324
-rw-r--r--lisp/gnus/deuglify.el10
-rw-r--r--lisp/gnus/gmm-utils.el6
-rw-r--r--lisp/gnus/gnus-agent.el31
-rw-r--r--lisp/gnus/gnus-art.el103
-rw-r--r--lisp/gnus/gnus-async.el1
-rw-r--r--lisp/gnus/gnus-bookmark.el11
-rw-r--r--lisp/gnus/gnus-cache.el30
-rw-r--r--lisp/gnus/gnus-cloud.el64
-rw-r--r--lisp/gnus/gnus-dbus.el70
-rw-r--r--lisp/gnus/gnus-delay.el6
-rw-r--r--lisp/gnus/gnus-draft.el2
-rw-r--r--lisp/gnus/gnus-eform.el18
-rw-r--r--lisp/gnus/gnus-fun.el15
-rw-r--r--lisp/gnus/gnus-gravatar.el14
-rw-r--r--lisp/gnus/gnus-group.el157
-rw-r--r--lisp/gnus/gnus-icalendar.el108
-rw-r--r--lisp/gnus/gnus-int.el53
-rw-r--r--lisp/gnus/gnus-kill.el2
-rw-r--r--lisp/gnus/gnus-msg.el152
-rw-r--r--lisp/gnus/gnus-registry.el166
-rw-r--r--lisp/gnus/gnus-score.el87
-rw-r--r--lisp/gnus/gnus-search.el2158
-rw-r--r--lisp/gnus/gnus-sieve.el10
-rw-r--r--lisp/gnus/gnus-srvr.el6
-rw-r--r--lisp/gnus/gnus-start.el130
-rw-r--r--lisp/gnus/gnus-sum.el409
-rw-r--r--lisp/gnus/gnus-topic.el4
-rw-r--r--lisp/gnus/gnus-util.el80
-rw-r--r--lisp/gnus/gnus-uu.el6
-rw-r--r--lisp/gnus/gnus-win.el2
-rw-r--r--lisp/gnus/gnus.el88
-rw-r--r--lisp/gnus/gssapi.el11
-rw-r--r--lisp/gnus/mail-source.el36
-rw-r--r--lisp/gnus/message.el417
-rw-r--r--lisp/gnus/mm-archive.el8
-rw-r--r--lisp/gnus/mm-decode.el49
-rw-r--r--lisp/gnus/mm-util.el79
-rw-r--r--lisp/gnus/mm-uu.el14
-rw-r--r--lisp/gnus/mm-view.el24
-rw-r--r--lisp/gnus/mml-sec.el64
-rw-r--r--lisp/gnus/mml-smime.el12
-rw-r--r--lisp/gnus/mml.el41
-rw-r--r--lisp/gnus/mml1991.el1
-rw-r--r--lisp/gnus/mml2015.el10
-rw-r--r--lisp/gnus/nnbabyl.el4
-rw-r--r--lisp/gnus/nndiary.el16
-rw-r--r--lisp/gnus/nndoc.el3
-rw-r--r--lisp/gnus/nndraft.el4
-rw-r--r--lisp/gnus/nneething.el2
-rw-r--r--lisp/gnus/nnfolder.el8
-rw-r--r--lisp/gnus/nnheader.el355
-rw-r--r--lisp/gnus/nnimap.el32
-rw-r--r--lisp/gnus/nnmail.el26
-rw-r--r--lisp/gnus/nnmaildir.el38
-rw-r--r--lisp/gnus/nnmairix.el6
-rw-r--r--lisp/gnus/nnmbox.el4
-rw-r--r--lisp/gnus/nnmh.el2
-rw-r--r--lisp/gnus/nnml.el19
-rw-r--r--lisp/gnus/nnrss.el4
-rw-r--r--lisp/gnus/nnselect.el970
-rw-r--r--lisp/gnus/nnspool.el2
-rw-r--r--lisp/gnus/nntp.el18
-rw-r--r--lisp/gnus/nnvirtual.el2
-rw-r--r--lisp/gnus/smiley.el93
-rw-r--r--lisp/gnus/smime.el8
-rw-r--r--lisp/gnus/spam-stat.el2
-rw-r--r--lisp/gnus/spam.el2
-rw-r--r--lisp/help-at-pt.el9
-rw-r--r--lisp/help-fns.el323
-rw-r--r--lisp/help-mode.el34
-rw-r--r--lisp/help.el593
-rw-r--r--lisp/hexl.el44
-rw-r--r--lisp/hfy-cmap.el45
-rw-r--r--lisp/hi-lock.el189
-rw-r--r--lisp/hilit-chg.el16
-rw-r--r--lisp/hippie-exp.el30
-rw-r--r--lisp/htmlfontify.el122
-rw-r--r--lisp/ibuf-ext.el32
-rw-r--r--lisp/ibuffer.el4
-rw-r--r--lisp/icomplete.el100
-rw-r--r--lisp/ido.el305
-rw-r--r--lisp/ielm.el44
-rw-r--r--lisp/image-dired.el11
-rw-r--r--lisp/image-file.el16
-rw-r--r--lisp/image-mode.el166
-rw-r--r--lisp/image.el10
-rw-r--r--lisp/image/gravatar.el170
-rw-r--r--lisp/image/image-converter.el38
-rw-r--r--lisp/imenu.el33
-rw-r--r--lisp/indent.el46
-rw-r--r--lisp/info-look.el13
-rw-r--r--lisp/info.el171
-rw-r--r--lisp/informat.el2
-rw-r--r--lisp/international/ccl.el8
-rw-r--r--lisp/international/characters.el2
-rw-r--r--lisp/international/fontset.el2
-rw-r--r--lisp/international/isearch-x.el12
-rw-r--r--lisp/international/iso-ascii.el5
-rw-r--r--lisp/international/ja-dic-cnv.el19
-rw-r--r--lisp/international/kinsoku.el2
-rw-r--r--lisp/international/mule-cmds.el235
-rw-r--r--lisp/international/mule-conf.el13
-rw-r--r--lisp/international/mule-diag.el4
-rw-r--r--lisp/international/mule-util.el30
-rw-r--r--lisp/international/mule.el190
-rw-r--r--lisp/international/ogonek.el8
-rw-r--r--lisp/international/quail.el28
-rw-r--r--lisp/international/rfc1843.el2
-rw-r--r--lisp/international/titdic-cnv.el240
-rw-r--r--lisp/international/ucs-normalize.el20
-rw-r--r--lisp/isearch.el162
-rw-r--r--lisp/jit-lock.el41
-rw-r--r--lisp/jka-compr.el10
-rw-r--r--lisp/json.el577
-rw-r--r--lisp/jsonrpc.el121
-rw-r--r--lisp/kermit.el2
-rw-r--r--lisp/kmacro.el2
-rw-r--r--lisp/language/burmese.el3
-rw-r--r--lisp/language/cham.el2
-rw-r--r--lisp/language/chinese.el5
-rw-r--r--lisp/language/cyril-util.el2
-rw-r--r--lisp/language/cyrillic.el7
-rw-r--r--lisp/language/czech.el2
-rw-r--r--lisp/language/georgian.el2
-rw-r--r--lisp/language/greek.el2
-rw-r--r--lisp/language/hanja-util.el4
-rw-r--r--lisp/language/hebrew.el2
-rw-r--r--lisp/language/ind-util.el40
-rw-r--r--lisp/language/indian.el2
-rw-r--r--lisp/language/japanese.el10
-rw-r--r--lisp/language/khmer.el2
-rw-r--r--lisp/language/korea-util.el4
-rw-r--r--lisp/language/korean.el12
-rw-r--r--lisp/language/lao-util.el16
-rw-r--r--lisp/language/misc-lang.el61
-rw-r--r--lisp/language/romanian.el2
-rw-r--r--lisp/language/sinhala.el2
-rw-r--r--lisp/language/slovak.el2
-rw-r--r--lisp/language/tai-viet.el2
-rw-r--r--lisp/language/tibet-util.el16
-rw-r--r--lisp/language/tibetan.el8
-rw-r--r--lisp/language/utf-8-lang.el2
-rw-r--r--lisp/language/vietnamese.el2
-rw-r--r--lisp/ldefs-boot.el6325
-rw-r--r--lisp/leim/quail/compose.el2952
-rw-r--r--lisp/leim/quail/indian.el89
-rw-r--r--lisp/leim/quail/ipa.el2
-rw-r--r--lisp/leim/quail/latin-ltx.el13
-rw-r--r--lisp/leim/quail/latin-post.el35
-rw-r--r--lisp/linum.el3
-rw-r--r--lisp/loadhist.el51
-rw-r--r--lisp/loadup.el4
-rw-r--r--lisp/locate.el14
-rw-r--r--lisp/ls-lisp.el15
-rw-r--r--lisp/mail/binhex.el26
-rw-r--r--lisp/mail/emacsbug.el231
-rw-r--r--lisp/mail/feedmail.el47
-rw-r--r--lisp/mail/flow-fill.el37
-rw-r--r--lisp/mail/footnote.el2
-rw-r--r--lisp/mail/hashcash.el16
-rw-r--r--lisp/mail/mail-extr.el85
-rw-r--r--lisp/mail/mail-parse.el2
-rw-r--r--lisp/mail/mail-prsvr.el2
-rw-r--r--lisp/mail/mailabbrev.el25
-rw-r--r--lisp/mail/mailalias.el8
-rw-r--r--lisp/mail/mailclient.el2
-rw-r--r--lisp/mail/mspools.el108
-rw-r--r--lisp/mail/qp.el6
-rw-r--r--lisp/mail/reporter.el1
-rw-r--r--lisp/mail/rfc2045.el2
-rw-r--r--lisp/mail/rfc2047.el6
-rw-r--r--lisp/mail/rfc2231.el36
-rw-r--r--lisp/mail/rfc2368.el2
-rw-r--r--lisp/mail/rfc822.el10
-rw-r--r--lisp/mail/rmail-spam-filter.el14
-rw-r--r--lisp/mail/rmail.el165
-rw-r--r--lisp/mail/rmailedit.el4
-rw-r--r--lisp/mail/rmailsum.el4
-rw-r--r--lisp/mail/sendmail.el4
-rw-r--r--lisp/mail/smtpmail.el18
-rw-r--r--lisp/mail/uudecode.el25
-rw-r--r--lisp/man.el42
-rw-r--r--lisp/master.el12
-rw-r--r--lisp/md4.el19
-rw-r--r--lisp/menu-bar.el292
-rw-r--r--lisp/mh-e/ChangeLog.124
-rw-r--r--lisp/mh-e/mh-comp.el3
-rw-r--r--lisp/mh-e/mh-e.el110
-rw-r--r--lisp/mh-e/mh-limit.el4
-rw-r--r--lisp/mh-e/mh-seq.el6
-rw-r--r--lisp/mh-e/mh-show.el3
-rw-r--r--lisp/mh-e/mh-speed.el2
-rw-r--r--lisp/mh-e/mh-thread.el4
-rw-r--r--lisp/minibuf-eldef.el22
-rw-r--r--lisp/minibuffer.el213
-rw-r--r--lisp/misc.el16
-rw-r--r--lisp/misearch.el6
-rw-r--r--lisp/mouse.el584
-rw-r--r--lisp/mpc.el15
-rw-r--r--lisp/msb.el2
-rw-r--r--lisp/mwheel.el153
-rw-r--r--lisp/net/ange-ftp.el137
-rw-r--r--lisp/net/browse-url.el426
-rw-r--r--lisp/net/dbus.el1382
-rw-r--r--lisp/net/dig.el11
-rw-r--r--lisp/net/dns.el284
-rw-r--r--lisp/net/eudc-bob.el136
-rw-r--r--lisp/net/eudc-vars.el2
-rw-r--r--lisp/net/eudcb-ldap.el19
-rw-r--r--lisp/net/eudcb-macos-contacts.el123
-rw-r--r--lisp/net/eww.el384
-rw-r--r--lisp/net/gnutls.el15
-rw-r--r--lisp/net/goto-addr.el10
-rw-r--r--lisp/net/hmac-def.el2
-rw-r--r--lisp/net/hmac-md5.el40
-rw-r--r--lisp/net/imap.el62
-rw-r--r--lisp/net/ldap.el4
-rw-r--r--lisp/net/mailcap.el98
-rw-r--r--lisp/net/net-utils.el7
-rw-r--r--lisp/net/netrc.el6
-rw-r--r--lisp/net/network-stream.el89
-rw-r--r--lisp/net/newst-backend.el12
-rw-r--r--lisp/net/newst-treeview.el30
-rw-r--r--lisp/net/newsticker.el10
-rw-r--r--lisp/net/nsm.el13
-rw-r--r--lisp/net/ntlm.el110
-rw-r--r--lisp/net/puny.el12
-rw-r--r--lisp/net/rcirc.el30
-rw-r--r--lisp/net/rfc2104.el2
-rw-r--r--lisp/net/sasl-ntlm.el2
-rw-r--r--lisp/net/sasl-scram-sha256.el59
-rw-r--r--lisp/net/sasl.el5
-rw-r--r--lisp/net/secrets.el6
-rw-r--r--lisp/net/shr.el273
-rw-r--r--lisp/net/sieve-mode.el7
-rw-r--r--lisp/net/snmp-mode.el4
-rw-r--r--lisp/net/soap-client.el152
-rw-r--r--lisp/net/socks.el9
-rw-r--r--lisp/net/telnet.el2
-rw-r--r--lisp/net/tramp-adb.el738
-rw-r--r--lisp/net/tramp-archive.el27
-rw-r--r--lisp/net/tramp-cache.el252
-rw-r--r--lisp/net/tramp-cmds.el68
-rw-r--r--lisp/net/tramp-compat.el153
-rw-r--r--lisp/net/tramp-crypt.el844
-rw-r--r--lisp/net/tramp-ftp.el7
-rw-r--r--lisp/net/tramp-gvfs.el858
-rw-r--r--lisp/net/tramp-rclone.el38
-rw-r--r--lisp/net/tramp-sh.el1168
-rw-r--r--lisp/net/tramp-smb.el271
-rw-r--r--lisp/net/tramp-sudoedit.el138
-rw-r--r--lisp/net/tramp-uu.el5
-rw-r--r--lisp/net/tramp.el798
-rw-r--r--lisp/net/trampver.el14
-rw-r--r--lisp/net/webjump.el6
-rw-r--r--lisp/notifications.el2
-rw-r--r--lisp/nxml/nxml-mode.el2
-rw-r--r--lisp/nxml/xsd-regexp.el4
-rw-r--r--lisp/obsolete/complete.el2
-rw-r--r--lisp/obsolete/cust-print.el5
-rw-r--r--lisp/obsolete/erc-compat.el (renamed from lisp/erc/erc-compat.el)21
-rw-r--r--lisp/obsolete/erc-hecomplete.el2
-rw-r--r--lisp/obsolete/iswitchb.el2
-rw-r--r--lisp/obsolete/ledit.el157
-rw-r--r--lisp/obsolete/levents.el292
-rw-r--r--lisp/obsolete/lmenu.el445
-rw-r--r--lisp/obsolete/longlines.el17
-rw-r--r--lisp/obsolete/lucid.el211
-rw-r--r--lisp/obsolete/metamail.el (renamed from lisp/mail/metamail.el)1
-rw-r--r--lisp/obsolete/nnir.el (renamed from lisp/gnus/nnir.el)939
-rw-r--r--lisp/obsolete/old-whitespace.el801
-rw-r--r--lisp/obsolete/rcompile.el2
-rw-r--r--lisp/obsolete/sb-image.el46
-rw-r--r--lisp/obsolete/tls.el16
-rw-r--r--lisp/obsolete/tpu-edt.el12
-rw-r--r--lisp/obsolete/vc-arch.el11
-rw-r--r--lisp/obsolete/vi.el2
-rw-r--r--lisp/obsolete/vip.el14
-rw-r--r--lisp/org/ChangeLog.178
-rw-r--r--lisp/org/ob-coq.el2
-rw-r--r--lisp/org/ob-core.el5
-rw-r--r--lisp/org/ob-fortran.el2
-rw-r--r--lisp/org/ob-js.el6
-rw-r--r--lisp/org/ob-plantuml.el2
-rw-r--r--lisp/org/ob-ruby.el16
-rw-r--r--lisp/org/ob-sass.el2
-rw-r--r--lisp/org/ob-screen.el2
-rw-r--r--lisp/org/ob-stan.el2
-rw-r--r--lisp/org/ob-vala.el2
-rw-r--r--lisp/org/ol-gnus.el6
-rw-r--r--lisp/org/ol.el4
-rw-r--r--lisp/org/org-agenda.el10
-rw-r--r--lisp/org/org-capture.el2
-rw-r--r--lisp/org/org-element.el6
-rw-r--r--lisp/org/org-protocol.el2
-rw-r--r--lisp/org/org-table.el10
-rw-r--r--lisp/org/org-tempo.el2
-rw-r--r--lisp/org/org.el15
-rw-r--r--lisp/org/ox-latex.el2
-rw-r--r--lisp/org/ox-odt.el10
-rw-r--r--lisp/org/ox.el4
-rw-r--r--lisp/outline.el213
-rw-r--r--lisp/password-cache.el19
-rw-r--r--lisp/pcmpl-cvs.el8
-rw-r--r--lisp/pcmpl-gnu.el15
-rw-r--r--lisp/pcmpl-linux.el12
-rw-r--r--lisp/pcmpl-rpm.el10
-rw-r--r--lisp/pcmpl-unix.el47
-rw-r--r--lisp/pcmpl-x.el34
-rw-r--r--lisp/pcomplete.el61
-rw-r--r--lisp/pixel-scroll.el3
-rw-r--r--lisp/play/5x5.el2
-rw-r--r--lisp/play/animate.el4
-rw-r--r--lisp/play/bubbles.el20
-rw-r--r--lisp/play/dissociate.el2
-rw-r--r--lisp/play/dunnet.el4
-rw-r--r--lisp/play/fortune.el68
-rw-r--r--lisp/play/gamegrid.el11
-rw-r--r--lisp/play/gametree.el6
-rw-r--r--lisp/play/gomoku.el46
-rw-r--r--lisp/play/handwrite.el12
-rw-r--r--lisp/play/life.el88
-rw-r--r--lisp/play/pong.el20
-rw-r--r--lisp/play/snake.el5
-rw-r--r--lisp/play/solitaire.el8
-rw-r--r--lisp/play/spook.el8
-rw-r--r--lisp/play/tetris.el2
-rw-r--r--lisp/printing.el40
-rw-r--r--lisp/proced.el119
-rw-r--r--lisp/profiler.el4
-rw-r--r--lisp/progmodes/antlr-mode.el11
-rw-r--r--lisp/progmodes/autoconf.el2
-rw-r--r--lisp/progmodes/bat-mode.el2
-rw-r--r--lisp/progmodes/bug-reference.el303
-rw-r--r--lisp/progmodes/cc-align.el38
-rw-r--r--lisp/progmodes/cc-awk.el2
-rw-r--r--lisp/progmodes/cc-cmds.el132
-rw-r--r--lisp/progmodes/cc-defs.el71
-rw-r--r--lisp/progmodes/cc-engine.el305
-rw-r--r--lisp/progmodes/cc-fonts.el141
-rw-r--r--lisp/progmodes/cc-langs.el72
-rw-r--r--lisp/progmodes/cc-mode.el397
-rw-r--r--lisp/progmodes/cc-styles.el6
-rw-r--r--lisp/progmodes/cc-vars.el16
-rw-r--r--lisp/progmodes/cfengine.el16
-rw-r--r--lisp/progmodes/cl-font-lock.el290
-rw-r--r--lisp/progmodes/compile.el411
-rw-r--r--lisp/progmodes/cperl-mode.el481
-rw-r--r--lisp/progmodes/cpp.el2
-rw-r--r--lisp/progmodes/cwarn.el4
-rw-r--r--lisp/progmodes/dcl-mode.el5
-rw-r--r--lisp/progmodes/ebnf-abn.el13
-rw-r--r--lisp/progmodes/ebnf-bnf.el6
-rw-r--r--lisp/progmodes/ebnf-dtd.el19
-rw-r--r--lisp/progmodes/ebnf-ebx.el20
-rw-r--r--lisp/progmodes/ebnf-iso.el6
-rw-r--r--lisp/progmodes/ebnf-yac.el6
-rw-r--r--lisp/progmodes/ebnf2ps.el58
-rw-r--r--lisp/progmodes/ebrowse.el458
-rw-r--r--lisp/progmodes/elisp-mode.el185
-rw-r--r--lisp/progmodes/etags.el16
-rw-r--r--lisp/progmodes/f90.el41
-rw-r--r--lisp/progmodes/flymake-cc.el8
-rw-r--r--lisp/progmodes/flymake-proc.el2
-rw-r--r--lisp/progmodes/flymake.el25
-rw-r--r--lisp/progmodes/fortran.el11
-rw-r--r--lisp/progmodes/gdb-mi.el1094
-rw-r--r--lisp/progmodes/glasses.el11
-rw-r--r--lisp/progmodes/grep.el152
-rw-r--r--lisp/progmodes/gud.el43
-rw-r--r--lisp/progmodes/hideif.el10
-rw-r--r--lisp/progmodes/hideshow.el5
-rw-r--r--lisp/progmodes/idlw-complete-structtag.el9
-rw-r--r--lisp/progmodes/idlw-help.el9
-rw-r--r--lisp/progmodes/idlw-shell.el19
-rw-r--r--lisp/progmodes/idlw-toolbar.el2
-rw-r--r--lisp/progmodes/idlwave.el240
-rw-r--r--lisp/progmodes/inf-lisp.el12
-rw-r--r--lisp/progmodes/js.el16
-rw-r--r--lisp/progmodes/ld-script.el2
-rw-r--r--lisp/progmodes/m4-mode.el15
-rw-r--r--lisp/progmodes/make-mode.el41
-rw-r--r--lisp/progmodes/meta-mode.el2
-rw-r--r--lisp/progmodes/mixal-mode.el50
-rw-r--r--lisp/progmodes/octave.el25
-rw-r--r--lisp/progmodes/opascal.el2
-rw-r--r--lisp/progmodes/pascal.el57
-rw-r--r--lisp/progmodes/perl-mode.el8
-rw-r--r--lisp/progmodes/project.el841
-rw-r--r--lisp/progmodes/prolog.el108
-rw-r--r--lisp/progmodes/python.el286
-rw-r--r--lisp/progmodes/ruby-mode.el69
-rw-r--r--lisp/progmodes/scheme.el2
-rw-r--r--lisp/progmodes/sh-script.el1464
-rw-r--r--lisp/progmodes/sql.el234
-rw-r--r--lisp/progmodes/subword.el2
-rw-r--r--lisp/progmodes/tcl.el158
-rw-r--r--lisp/progmodes/vera-mode.el69
-rw-r--r--lisp/progmodes/verilog-mode.el317
-rw-r--r--lisp/progmodes/vhdl-mode.el17
-rw-r--r--lisp/progmodes/which-func.el97
-rw-r--r--lisp/progmodes/xref.el119
-rw-r--r--lisp/progmodes/xscheme.el2
-rw-r--r--lisp/ps-def.el22
-rw-r--r--lisp/ps-print.el16
-rw-r--r--lisp/ps-samp.el2
-rw-r--r--lisp/recentf.el15
-rw-r--r--lisp/rect.el9
-rw-r--r--lisp/registry.el2
-rw-r--r--lisp/repeat.el6
-rw-r--r--lisp/replace.el158
-rw-r--r--lisp/reposition.el2
-rw-r--r--lisp/reveal.el22
-rw-r--r--lisp/ruler-mode.el2
-rw-r--r--lisp/savehist.el6
-rw-r--r--lisp/saveplace.el16
-rw-r--r--lisp/sb-image.el107
-rw-r--r--lisp/scroll-lock.el2
-rw-r--r--lisp/server.el135
-rw-r--r--lisp/ses.el16
-rw-r--r--lisp/shadowfile.el31
-rw-r--r--lisp/shell.el122
-rw-r--r--lisp/simple.el615
-rw-r--r--lisp/skeleton.el102
-rw-r--r--lisp/so-long.el10
-rw-r--r--lisp/sort.el60
-rw-r--r--lisp/speedbar.el128
-rw-r--r--lisp/startup.el12
-rw-r--r--lisp/strokes.el11
-rw-r--r--lisp/subr.el230
-rw-r--r--lisp/svg.el2
-rw-r--r--lisp/t-mouse.el4
-rw-r--r--lisp/tab-bar.el129
-rw-r--r--lisp/tab-line.el51
-rw-r--r--lisp/talk.el2
-rw-r--r--lisp/tar-mode.el79
-rw-r--r--lisp/tempo.el68
-rw-r--r--lisp/term.el111
-rw-r--r--lisp/term/AT386.el2
-rw-r--r--lisp/term/bobcat.el1
-rw-r--r--lisp/term/cygwin.el2
-rw-r--r--lisp/term/internal.el8
-rw-r--r--lisp/term/iris-ansi.el2
-rw-r--r--lisp/term/konsole.el2
-rw-r--r--lisp/term/linux.el2
-rw-r--r--lisp/term/lk201.el2
-rw-r--r--lisp/term/news.el2
-rw-r--r--lisp/term/ns-win.el37
-rw-r--r--lisp/term/rxvt.el23
-rw-r--r--lisp/term/st.el20
-rw-r--r--lisp/term/sun.el2
-rw-r--r--lisp/term/tty-colors.el58
-rw-r--r--lisp/term/tvi970.el2
-rw-r--r--lisp/term/vt100.el2
-rw-r--r--lisp/term/vt200.el2
-rw-r--r--lisp/term/w32-win.el6
-rw-r--r--lisp/term/wyse50.el8
-rw-r--r--lisp/term/x-win.el10
-rw-r--r--lisp/textmodes/artist.el122
-rw-r--r--lisp/textmodes/bibtex.el356
-rw-r--r--lisp/textmodes/conf-mode.el191
-rw-r--r--lisp/textmodes/css-mode.el83
-rw-r--r--lisp/textmodes/flyspell.el137
-rw-r--r--lisp/textmodes/ispell.el197
-rw-r--r--lisp/textmodes/mhtml-mode.el97
-rw-r--r--lisp/textmodes/nroff-mode.el1
-rw-r--r--lisp/textmodes/page-ext.el21
-rw-r--r--lisp/textmodes/paragraphs.el65
-rw-r--r--lisp/textmodes/picture.el2
-rw-r--r--lisp/textmodes/po.el2
-rw-r--r--lisp/textmodes/refer.el12
-rw-r--r--lisp/textmodes/reftex-ref.el4
-rw-r--r--lisp/textmodes/reftex-vars.el4
-rw-r--r--lisp/textmodes/reftex.el2
-rw-r--r--lisp/textmodes/remember.el6
-rw-r--r--lisp/textmodes/rst.el20
-rw-r--r--lisp/textmodes/sgml-mode.el37
-rw-r--r--lisp/textmodes/table.el55
-rw-r--r--lisp/textmodes/tex-mode.el75
-rw-r--r--lisp/textmodes/texinfo.el84
-rw-r--r--lisp/textmodes/tildify.el4
-rw-r--r--lisp/thingatpt.el6
-rw-r--r--lisp/thread.el2
-rw-r--r--lisp/thumbs.el2
-rw-r--r--lisp/time.el442
-rw-r--r--lisp/tmm.el56
-rw-r--r--lisp/tool-bar.el6
-rw-r--r--lisp/tooltip.el30
-rw-r--r--lisp/type-break.el8
-rw-r--r--lisp/uniquify.el21
-rw-r--r--lisp/url/ChangeLog.12
-rw-r--r--lisp/url/url-about.el2
-rw-r--r--lisp/url/url-auth.el28
-rw-r--r--lisp/url/url-cache.el27
-rw-r--r--lisp/url/url-dired.el2
-rw-r--r--lisp/url/url-domsuf.el15
-rw-r--r--lisp/url/url-expand.el21
-rw-r--r--lisp/url/url-ftp.el2
-rw-r--r--lisp/url/url-gw.el2
-rw-r--r--lisp/url/url-handlers.el3
-rw-r--r--lisp/url/url-http.el35
-rw-r--r--lisp/url/url-irc.el8
-rw-r--r--lisp/url/url-news.el2
-rw-r--r--lisp/url/url-queue.el29
-rw-r--r--lisp/url/url-util.el29
-rw-r--r--lisp/url/url-vars.el12
-rw-r--r--lisp/url/url.el21
-rw-r--r--lisp/vc/add-log.el2
-rw-r--r--lisp/vc/diff-mode.el64
-rw-r--r--lisp/vc/diff.el2
-rw-r--r--lisp/vc/ediff-diff.el4
-rw-r--r--lisp/vc/ediff-init.el56
-rw-r--r--lisp/vc/ediff-mult.el17
-rw-r--r--lisp/vc/ediff-ptch.el2
-rw-r--r--lisp/vc/ediff-util.el70
-rw-r--r--lisp/vc/ediff-vers.el25
-rw-r--r--lisp/vc/ediff-wind.el21
-rw-r--r--lisp/vc/ediff.el101
-rw-r--r--lisp/vc/emerge.el5
-rw-r--r--lisp/vc/log-edit.el15
-rw-r--r--lisp/vc/log-view.el14
-rw-r--r--lisp/vc/pcvs-parse.el2
-rw-r--r--lisp/vc/smerge-mode.el53
-rw-r--r--lisp/vc/vc-annotate.el4
-rw-r--r--lisp/vc/vc-bzr.el11
-rw-r--r--lisp/vc/vc-cvs.el35
-rw-r--r--lisp/vc/vc-dir.el94
-rw-r--r--lisp/vc/vc-dispatcher.el10
-rw-r--r--lisp/vc/vc-git.el79
-rw-r--r--lisp/vc/vc-hg.el78
-rw-r--r--lisp/vc/vc-hooks.el16
-rw-r--r--lisp/vc/vc-mtn.el1
-rw-r--r--lisp/vc/vc-rcs.el2
-rw-r--r--lisp/vc/vc-src.el67
-rw-r--r--lisp/vc/vc-svn.el13
-rw-r--r--lisp/vc/vc.el159
-rw-r--r--lisp/vcursor.el20
-rw-r--r--lisp/version.el4
-rw-r--r--lisp/vt-control.el2
-rw-r--r--lisp/vt100-led.el2
-rw-r--r--lisp/w32-fns.el10
-rw-r--r--lisp/w32-vars.el14
-rw-r--r--lisp/wdired.el181
-rw-r--r--lisp/whitespace.el73
-rw-r--r--lisp/wid-browse.el2
-rw-r--r--lisp/wid-edit.el502
-rw-r--r--lisp/windmove.el83
-rw-r--r--lisp/window.el247
-rw-r--r--lisp/woman.el32
-rw-r--r--lisp/x-dnd.el61
-rw-r--r--lisp/xml.el23
-rw-r--r--lisp/xt-mouse.el40
-rw-r--r--lisp/xwidget.el278
871 files changed, 43568 insertions, 29429 deletions
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index 54412223248..177ca08ef3b 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -12772,7 +12772,7 @@
(reftex-words-to-typekey-alist, reftex-key-to-index-macro-alist)
(reftex-query-index-macro-prompt, reftex-query-index-macro-help)
(reftex-no-follow-message, reftex-no-info-message): Likewise.
- (reftex-mode): Define systax table for bibtex parsing.
+ (reftex-mode): Define syntax table for bibtex parsing.
(reftex-syntax-table-for-bib): Syntax table for bibtex parsing.
* textmodes/reftex-cite.el (reftex-format-names): %a as name
@@ -15993,7 +15993,7 @@
* progmodes/cc-vars.el (c-offsets-alist): A more sane default
for `inexpr-statement'. This is not compatible, though.
- I think the benefit of a good default style outweights that in
+ I think the benefit of a good default style outweighs that in
this case. Besides, `inexpr-statement' is not very common.
2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11
index 52b85950be0..374a5668932 100644
--- a/lisp/ChangeLog.11
+++ b/lisp/ChangeLog.11
@@ -13392,7 +13392,7 @@
* progmodes/compile.el (compilation-error-regexp-alist):
Add Java ANt error detection as described in document
- http://ant.apache.org/faq.html
+ https://ant.apache.org/faq.html
2003-08-12 Juri Linkov <juri@jurta.org> (tiny change)
diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12
index a9d0067598e..40aa8c4dc83 100644
--- a/lisp/ChangeLog.12
+++ b/lisp/ChangeLog.12
@@ -16274,7 +16274,7 @@
(c-guess-basic-syntax): Adapt case 5B for the new
`c-just-after-func-arglist-p'. Merge cases 5B.1 and 5B.3.
- Remove cases 5D.1 and 5D.2 since they aren't trigged anymore (case 5B.1
+ Remove cases 5D.1 and 5D.2 since they aren't triggered anymore (case 5B.1
covers all cases now).
* progmodes/cc-defs.el (c-point): Add `bosws' and `eosws'.
@@ -32889,7 +32889,7 @@
2005-01-14 Nick Roberts <nickrob@snap.net.nz>
- * xt-mouse.el (xterm-mouse-event): Compute window co-ordinates
+ * xt-mouse.el (xterm-mouse-event): Compute window coordinates
more carefully.
2005-01-13 Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13
index 779a641d16a..1a2863afa97 100644
--- a/lisp/ChangeLog.13
+++ b/lisp/ChangeLog.13
@@ -4765,7 +4765,7 @@
2007-12-30 Michael Albinus <michael.albinus@gmx.de>
* net/dbus.el (dbus-name-owner-changed-handler): Make the function
- resistent towards wrong parameters.
+ resistant towards wrong parameters.
(dbus-handle-event): Propagate D-Bus errors only in the debug case.
2007-12-30 Richard Stallman <rms@gnu.org>
@@ -5001,7 +5001,7 @@
* vc.el (vc-dired-ignorable-p, vc-dired-hook): Speed optimization;
use completion-ignored-extensions to detect files that should be
- ignorted in VC-Dired listings, heading off lots of expensive calls
+ ignored in VC-Dired listings, heading off lots of expensive calls
to (vc-state).
* vc.el (vc-dired-hook): Show unregistered file status as "?" in
diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14
index 00b6a6ac41b..e9c8a8ff8be 100644
--- a/lisp/ChangeLog.14
+++ b/lisp/ChangeLog.14
@@ -10889,7 +10889,7 @@
* menu-bar.el (menu-set-font): New function. Bind "Set Default
Font" menu item to it. Apply selected font to all frames, and
- make it savable.
+ make it saveable.
(menu-bar-options-save): Save `default' font if changed.
2008-06-10 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -13625,7 +13625,7 @@
(completion-emacs22-try-completion): Place cursor after the /, as was
done in Emacs-22's minibuffer-complete-word.
Fix bug reported by David Hansen <david.hansen@gmx.net>.
- (completion-emacs22-try-completion): Merge all mergable text rather
+ (completion-emacs22-try-completion): Merge all mergeable text rather
than just /.
(completion-pcm--delim-wild-regex): New var.
(completion-pcm-word-delimiters): New custom.
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index e66766eafa5..3a578da4bc7 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -2803,7 +2803,7 @@
2010-12-29 Karl Fogel <kfogel@red-bean.com>
* saveplace.el (save-place-alist-to-file): Save list sorted and
- pretty-printed, so that it is mergable by line-based text merging,
+ pretty-printed, so that it is mergeable by line-based text merging,
as suggested by Iain Dalton <iain.dalton {_AT_} gmail.com>.
2010-12-28 Ken Manheimer <ken.manheimer@gmail.com>
@@ -5135,10 +5135,10 @@
* progmodes/verilog-mode.el (verilog-directive-re): Make this variable
auto-built for efficiency of execution and updating.
- (verilog-extended-complete-re): Support 'pure' fucntion & task
+ (verilog-extended-complete-re): Support 'pure' function & task
declarations (these have no bodies).
(verilog-beg-of-statement): General cleanup to enable support of
- 'pure' fucntion & task declarations (these have no bodies).
+ 'pure' function & task declarations (these have no bodies).
These efforts together fix Verilog bug210 from veripool; which was also
noticed by Steve Pearlmutter.
(verilog-directive-re, verilog-directive-begin, verilog-indent-re)
@@ -10689,7 +10689,7 @@
2010-05-13 Agustín Martín <agustin.martin@hispalinux.es>
* textmodes/ispell.el (ispell-init-process): Do not kill ispell
- process everytime when spellchecking from the minibuffer (bug#6143).
+ process every time when spellchecking from the minibuffer (bug#6143).
2010-05-13 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -12100,7 +12100,7 @@
2010-03-31 Juri Linkov <juri@jurta.org>
* image.el (image-animated-p): Use `image-metadata' instead of
- `image-extension-data'. Get GIF extenstion data from metadata
+ `image-extension-data'. Get GIF extension data from metadata
property `extension-data'.
2010-03-31 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -14907,7 +14907,7 @@
Use complete-with-action rather than pascal-completion-response and
let it apply the predicate as well.
(pascal-goto-defun): Change buffer before calling pascal-comp-defun
- when neded.
+ when needed.
2009-12-02 Kenichi Handa <handa@m17n.org>
@@ -18684,7 +18684,7 @@
2009-09-24 Vinicius Jose Latorre <viniciusjl@ig.com.br>
* whitespace.el: Does not highlight trailing spaces While point is
- at end of line. Does not highligt spaces at beginning of buffer
+ at end of line. Does not highlight spaces at beginning of buffer
while point is at beginning of buffer. Does not highlight spaces
at end of buffer while point is at end of buffer. (Bug#4177)
New version 12.0.
diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16
index b4da88e6346..bb7389c5b71 100644
--- a/lisp/ChangeLog.16
+++ b/lisp/ChangeLog.16
@@ -379,7 +379,7 @@
2013-02-28 Sam Steingold <sds@gnu.org>
* vc/diff-mode.el (diff-hunk-file-names): Handle filenames with spaces.
- See <http://stackoverflow.com/questions/14720205>.
+ See <https://stackoverflow.com/questions/14720205>.
2013-02-28 Thierry Volpiatto <thierry.volpiatto@gmail.com>
@@ -1326,7 +1326,7 @@
* net/soap-client.el (soap-invoke): Encode the string for
`url-request-data' as UTF-8.
- Fixes <http://code.google.com/p/emacs-soap-client/issues/detail?id=16>.
+ Fixes <https://code.google.com/p/emacs-soap-client/issues/detail?id=16>.
2013-02-01 Glenn Morris <rgm@gnu.org>
@@ -2462,7 +2462,7 @@
2012-12-27 Sam Steingold <sds@gnu.org>
* progmodes/cperl-mode.el (cperl-calculate-indent): Do not stagger
- continuations, see <http://stackoverflow.com/questions/3582436>.
+ continuations, see <https://stackoverflow.com/questions/3582436>.
2012-12-27 Dmitry Gutov <dgutov@yandex.ru>
@@ -3018,7 +3018,7 @@
* progmodes/sql.el: Use cl-lib and lexical-binding; various cleanup.
(sql-signum): Remove. Use `cl-signum' instead.
- (sql-read-passwd): Remove; use read-passwd instread.
+ (sql-read-passwd): Remove; use read-passwd instead.
(sql-get-login-ext): Use read-string.
(sql-get-login): Use dolist and pcase.
(sql--completion-table): Rename from sql-try-completion.
@@ -7833,7 +7833,7 @@
the form for POSITION argument.
* term/x-win.el (x-menu-bar-open):
- Use the value returend from (posn-at-point) as position
+ Use the value returned from (posn-at-point) as position
passed to `popup-menu'.
2012-08-09 Jay Belanger <jay.p.belanger@gmail.com>
@@ -11473,7 +11473,7 @@
(sh-set-shell): Use smie-setup if requested.
* term.el (term-set-escape-char): Properly set term-escape-char.
- See http://stackoverflow.com/questions/10524656.
+ See https://stackoverflow.com/questions/10524656.
2012-05-10 Chong Yidong <cyd@gnu.org>
@@ -11992,11 +11992,11 @@
* progmodes/verilog-mode.el (verilog-pretty-expr): Don't line up
assignment with tests in ifs and for loops.
(verilog-extended-complete-re, verilog-complete-reg): Change so
- that DPI inport functions don't look like function declarations.
+ that DPI import functions don't look like function declarations.
(verilog-pretty-expr): Don't line up assignment
operations to the test and increment in if and for loops
(verilog-extended-complete-re, verilog-complete-reg): Change so
- that DPI inport functions don't look like function declarations.
+ that DPI import functions don't look like function declarations.
2012-05-03 Kenichi Handa <handa@m17n.org>
@@ -15918,7 +15918,7 @@
Rework verilog-pretty-expr to handle new assignment operators in system
verilog, such as += *= and the like.
(verilog-assignment-operator-re): Regular expression to find the
- assigment operator in a verilog assignment.
+ assignment operator in a verilog assignment.
(verilog-assignment-operation-re): Regular expression to find an
assignment statement for pretty-expr.
(verilog-in-attribute-p): Query returns true if point is in an
@@ -16476,7 +16476,7 @@
(python-pdbtrack-track-stack-file): Adjust to recognize ipdb as well as
regular python pdb prompts. Adjustments shamelessly taken exactly as
suggested in EmacsWiki page (tiny change):
- http://www.emacswiki.org/PythonProgrammingInEmacs#toc14
+ https://www.emacswiki.org/PythonProgrammingInEmacs#toc14
2011-11-16 Juanma Barranquero <lekktu@gmail.com>
@@ -20442,7 +20442,7 @@
2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
* net/network-stream.el (open-network-stream): Use the
- :end-of-capability command thoughout.
+ :end-of-capability command throughout.
2011-07-03 Wolfgang Jenkner <wjenkner@inode.at> (tiny change)
@@ -21496,7 +21496,7 @@
* net/network-stream.el (open-network-stream): Add the keyword
:always-query-capabilities for the case where you want to force a
`plain' network connection, but the protocol still requires the
- capabilitiy command (i.e., SMTP and EHLO).
+ capability command (i.e., SMTP and EHLO).
* subr.el (process-live-p): Rename from `process-alive-p' for
consistency with other `-live-p' functions.
@@ -24707,7 +24707,7 @@
* abbrev.el (abbrev-edit-save-to-file, abbrev-edit-save-buffer):
New commands.
(edit-abbrevs-map): Bind them here.
- (write-abbrev-file): New optinal arg VERBOSE. (Bug#5937)
+ (write-abbrev-file): New optional arg VERBOSE. (Bug#5937)
2011-03-29 Ken Manheimer <ken.manheimer@gmail.com>
diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17
index a1a6363cdca..5789445fcd6 100644
--- a/lisp/ChangeLog.17
+++ b/lisp/ChangeLog.17
@@ -6540,8 +6540,8 @@
(newsticker--image-get): New arguments FILENAME and DIRECTORY.
Use `url-retrieve' if `newsticker-retrieval-method' is 'intern.
(newsticker--image-download-by-wget): New. Use process properties
- for storing informations.
- (newsticker--image-sentinel): Read informations from process properties.
+ for storing information.
+ (newsticker--image-sentinel): Read information from process properties.
(newsticker--image-save)
(newsticker--image-remove)
(newsticker--image-download-by-url)
@@ -8465,7 +8465,7 @@
2014-07-28 Glenn Morris <rgm@gnu.org>
* files.el (toggle-read-only): Re-add basic doc-string.
- * vc/vc-hooks.el (vc-toggle-read-only): Tweak obsolescence mesage.
+ * vc/vc-hooks.el (vc-toggle-read-only): Tweak obsolescence message.
* progmodes/prolog.el (prolog-mode-keybindings-edit):
Replace missing `switch-to-prolog' with `run-prolog'.
@@ -14399,7 +14399,7 @@
2014-01-05 Martin Rudalics <rudalics@gmx.at>
- * window.el (balance-windows): Add mising t to fix Bug#16351.
+ * window.el (balance-windows): Add missing t to fix Bug#16351.
2014-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -15098,7 +15098,7 @@
2013-12-18 Juri Linkov <juri@jurta.org>
* help-mode.el (help-mode-map): Bind "l" to help-go-back,
- and "r" to help-go-forward for compatibity with Info. (Bug#16178)
+ and "r" to help-go-forward for compatibility with Info. (Bug#16178)
2013-12-18 Leo Liu <sdl.web@gmail.com>
@@ -15729,7 +15729,7 @@
(flymake-get-temp-dir): Remove.
(flymake-popup-menu, flymake-nop, flymake-make-xemacs-menu)
(flymake-current-row, flymake-selected-frame)
- (flymake-get-point-pixel-pos): Remove xemacs compatibity and
+ (flymake-get-point-pixel-pos): Remove xemacs compatibility and
related functions. (Bug#16077)
2013-12-07 Bozhidar Batsov <bozhidar@batsov.com>
@@ -16822,7 +16822,7 @@
* emacs-lisp/byte-run.el (defmacro, defun): Set their `indent' property.
* electric.el (electric-indent-post-self-insert-function):
- Only delete trailing whitepsace if it is indeed trailing (bug#15767).
+ Only delete trailing whitespace if it is indeed trailing (bug#15767).
2013-11-04 Helmut Eller <eller.helmut@gmail.com>
@@ -17770,7 +17770,7 @@
2013-10-13 Kenichi Handa <handa@gnu.org>
* international/mule-cmds.el (select-safe-coding-system): Remove a
- superfluous condition in chekcing whether a coding system is safe
+ superfluous condition in checking whether a coding system is safe
or not.
2013-10-13 Oleh Krehel <ohwoeowho@gmail.com>
@@ -23495,7 +23495,7 @@
* progmodes/cc-defs.el (c-set-region-active, c-beginning-of-defun-1)
* progmodes/cc-mode.el (c-make-inherited-keymap): Use plain fboundp.
* progmodes/cc-defs.el (zmacs-region-stays, zmacs-regions)
- (lookup-syntax-properties): Remove unecessary cc-bytecomp-defvar.
+ (lookup-syntax-properties): Remove unnecessary cc-bytecomp-defvar.
* progmodes/cc-vars.el (other): Emacs has this widget since
at least 21.1, so don't (re)define it.
@@ -23951,7 +23951,7 @@
* simple.el (shell-command-on-region): Pass the `replace' argument
down to `call-process-region' to comply with the doc as reported on
- <http://stackoverflow.com/questions/16720458/emacs-noninteractive-call-to-shell-command-on-region-always-deletes-region>
+ <https://stackoverflow.com/questions/16720458/emacs-noninteractive-call-to-shell-command-on-region-always-deletes-region>
2013-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/lisp/ChangeLog.3 b/lisp/ChangeLog.3
index 79bdbfd6660..ef0e423d145 100644
--- a/lisp/ChangeLog.3
+++ b/lisp/ChangeLog.3
@@ -6958,7 +6958,7 @@
1991-10-04 Roland McGrath (roland@albert.gnu.ai.mit.edu)
* rmail.el: Changed two regexps not to look specifically for 19yy
- for years; look for yyyy instead. Planning for the millenium.
+ for years; look for yyyy instead. Planning for the millennium.
1991-10-03 Roland McGrath (roland@albert.gnu.ai.mit.edu)
diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6
index 3fe6aea3b8e..87ae38b27e6 100644
--- a/lisp/ChangeLog.6
+++ b/lisp/ChangeLog.6
@@ -6742,7 +6742,7 @@
quoted tab into a space.
(sh-mode): Use new `skeleton-newline-indent-rigidly'.
(sh-set-shell): Make maximum font-locking also highlight keywords
- after ``' and `!'. (The latter is for ksh '93 but should't hurt other
+ after ``' and `!'. (The latter is for ksh '93 but shouldn't hurt other
shells.)
1995-08-18 Andre Spiegel <spiegel@berlin.informatik.uni-stuttgart.de>
diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7
index a0d42500e36..58a7fa402ba 100644
--- a/lisp/ChangeLog.7
+++ b/lisp/ChangeLog.7
@@ -5774,7 +5774,7 @@
1998-03-06 Dave Love <d.love@dl.ac.uk>
- * browse-url.el: Various doc fixes, mainly to remove innappropriate
+ * browse-url.el: Various doc fixes, mainly to remove inappropriate
leading "*"s.
(browse-url-new-window-p, browse-url-netscape-display)
(browse-url-save-file, browse-url-generic-program):
@@ -10843,7 +10843,7 @@
1997-09-06 Michael Kifer <kifer@cs.sunysb.edu>
* ediff-ptch.el (ediff-patch-buffer-internal):
- now behaves uniformely, whether the buffer
+ now behaves uniformly, whether the buffer
visits a file or not.
* ediff-util.el (ediff-other-buffer): Smarter selection of
suitable other buffer.
@@ -11291,7 +11291,7 @@
the various new variables mentioned above. Accept the `a' key to
use all selected citations.
(reftex-insert-bib-matches): New function.
- (reftex-format-citation): Now interpretes % escapes.
+ (reftex-format-citation): Now interprets % escapes.
(reftex-select-item): Emulate a search in the menu buffer.
Interpret the 'cnt text property.
(reftex-view-crossref): Allow more general label, cite and ref macros.
diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8
index 5c55597ddcf..e9b2138e4ba 100644
--- a/lisp/ChangeLog.8
+++ b/lisp/ChangeLog.8
@@ -7002,7 +7002,7 @@
1999-01-13 Eli Zaretskii <eliz@gnu.org>
* international/codepage.el (cp850-decode-table): Replace nil
- entries with codes of similary looking glyphs. (
+ entries with codes of similarly looking glyphs. (
Suggested by Jason Rumney <jasonr@altavista.net>.)
1999-01-13 Dave Love <fx@gnu.org>
@@ -7469,7 +7469,7 @@
(cperl-forward-re): Highlight the trailing / in s/foo// as string.
Highlight the starting // in s//foo/ as function-name.
Emit a meaningful error instead of a cryptic one for an
- uncomplete REx near end-of-buffer.
+ incomplete REx near end-of-buffer.
(cperl-electric-keyword): `qr' recognized.
(cperl-electric-else): Likewise.
diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9
index c6bfb1babd9..5372b242f5f 100644
--- a/lisp/ChangeLog.9
+++ b/lisp/ChangeLog.9
@@ -237,8 +237,8 @@
After 4.28:
(cperl-forward-re): Throw an error at proper moment REx unfinished.
After 4.29:
- (x-color-defined-p): Make an extra case to peacify the warning.
- Toplevel: `defvar' to peacify the warnings.
+ (x-color-defined-p): Make an extra case to pacify the warning.
+ Toplevel: `defvar' to pacify the warnings.
(cperl-find-pods-heres): Could access `font-lock-comment-face' in -nw.
No -nw-compile time warnings now.
(cperl-find-tags): TAGS file had too short substring-to-search.
@@ -1183,7 +1183,7 @@
2001-09-07 Gerd Moellmann <gerd@gnu.org>
* isearch.el (isearch-intersects-p): New function.
- (isearch-close-unnecessary-overlays): Rename from *unecessary*,
+ (isearch-close-unnecessary-overlays): Rename from *unnecessary*,
use isearch-intersects-p, and clean up.
2001-09-07 Eli Zaretskii <eliz@is.elta.co.il>
@@ -12432,7 +12432,7 @@
is not reached. It is.
(vc-cvs-merge): Set state to 'edited after merge.
(vc-cvs-merge-news): Set workfile version to nil if not known.
- (vc-cvs-latest-on-branch-p): Recommented. Candidate for removal.
+ (vc-cvs-latest-on-branch-p): Recommended. Candidate for removal.
* vc-cvs.el, vc-rcs.el, vc-sccs.el (vc-*-checkout): Switch off
coding systems for checkout via stdout. (Merge from main line.)
@@ -13371,7 +13371,7 @@
if defined. (Merged from main line, slightly adapted.)
* vc-cvs.el (vc-cvs-annotate-difference): Handle possible
- millenium problem (merged from mainline).
+ millennium problem (merged from mainline).
2000-09-04 Martin Lorentzson <martinl@gnu.org>
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index dac62cedec2..7c86e89ca99 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -196,7 +196,6 @@ $(lisp)/finder-inf.el:
autoloads .PHONY: $(lisp)/loaddefs.el
$(lisp)/loaddefs.el: gen-lisp $(LOADDEFS)
- @echo Directories for loaddefs: ${SUBDIRS_ALMOST}
$(AM_V_GEN)$(emacs) -l autoload \
--eval '(setq autoload-ensure-writable t)' \
--eval '(setq autoload-builtin-package-versions t)' \
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 190b3504fa7..f35c637eed5 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -189,17 +189,21 @@ the ones defined from the buffer now."
(table (read buf))
abbrevs name hook exp count sys)
(forward-line 1)
- (while (progn (forward-line 1)
- (not (eolp)))
- (setq name (read buf) count (read buf))
- (if (equal count '(sys))
- (setq sys t count (read buf))
- (setq sys nil))
- (setq exp (read buf))
- (skip-chars-backward " \t\n\f")
- (setq hook (if (not (eolp)) (read buf)))
- (skip-chars-backward " \t\n\f")
- (setq abbrevs (cons (list name exp hook count sys) abbrevs)))
+ (while (and (not (eobp))
+ ;; Advance as long as we're looking at blank lines
+ ;; or we have an abbrev.
+ (looking-at "[ \t\n]\\|\\(\"\\)"))
+ (when (match-string 1)
+ (setq name (read buf) count (read buf))
+ (if (equal count '(sys))
+ (setq sys t count (read buf))
+ (setq sys nil))
+ (setq exp (read buf))
+ (skip-chars-backward " \t\n\f")
+ (setq hook (if (not (eolp)) (read buf)))
+ (skip-chars-backward " \t\n\f")
+ (setq abbrevs (cons (list name exp hook count sys) abbrevs)))
+ (forward-line 1))
(define-abbrev-table table abbrevs)))))
(defun read-abbrev-file (&optional file quietly)
@@ -209,8 +213,7 @@ it defaults to the value of `abbrev-file-name'.
Optional second argument QUIETLY non-nil means don't display a message."
(interactive
(list
- (read-file-name (format "Read abbrev file (default %s): "
- abbrev-file-name)
+ (read-file-name (format-prompt "Read abbrev file" abbrev-file-name)
nil abbrev-file-name t)))
(load (or file abbrev-file-name) nil quietly)
(setq abbrevs-changed nil))
@@ -255,11 +258,7 @@ have been saved."
(if (abbrev--table-symbols table)
(insert-abbrev-table-description table nil)))
(when (unencodable-char-position (point-min) (point-max) 'utf-8)
- (setq coding-system-for-write
- (if (> emacs-major-version 24)
- 'utf-8-emacs
- ;; For compatibility with Emacs 22 (See Bug#8308)
- 'emacs-mule)))
+ (setq coding-system-for-write 'utf-8-emacs))
(goto-char (point-min))
(insert (format ";;-*-coding: %s;-*-\n" coding-system-for-write))
(write-region nil nil file nil (and (not verbose) 0)))))
@@ -521,14 +520,6 @@ It is nil if the abbrev has already been unexpanded.")
;; "Local (mode-specific) abbrev table of current buffer.")
;; (make-variable-buffer-local 'local-abbrev-table)
-(defcustom pre-abbrev-expand-hook nil
- "Function or functions to be called before abbrev expansion is done.
-This is the first thing that `expand-abbrev' does, and so this may change
-the current abbrev table before abbrev lookup happens."
- :type 'hook
- :group 'abbrev-mode)
-(make-obsolete-variable 'pre-abbrev-expand-hook 'abbrev-expand-function "23.1")
-
(defun clear-abbrev-table (table)
"Undefine all abbrevs in abbrev table TABLE, leaving it empty."
(setq abbrevs-changed t)
@@ -837,16 +828,155 @@ see `define-abbrev' for details."
"Function that `expand-abbrev' uses to perform abbrev expansion.
Takes no argument and should return the abbrev symbol if expansion took place.")
+(defcustom abbrev-suggest nil
+ "Non-nil means suggest using abbrevs to save typing.
+When abbrev mode is active and this option is non-nil, Emacs will
+suggest in the echo area to use an existing abbrev if doing so
+will save enough typing. See `abbrev-suggest-hint-threshold' for
+the definition of \"enough typing\"."
+ :type 'boolean
+ :version "28.1")
+
+(defcustom abbrev-suggest-hint-threshold 3
+ "Threshold for when to suggest to use an abbrev to save typing.
+The threshold is the amount of typing, in terms of the number of
+characters, that would be saved by using the abbrev. The
+thinking is that if the expansion is only a few characters
+longer than the abbrev, the benefit of informing the user is not
+significant. If you always want to be informed about existing
+abbrevs for the text you type, set this value to zero or less.
+This setting only applies if `abbrev-suggest' is non-nil."
+ :type 'number
+ :version "28.1")
+
+(defun abbrev--suggest-get-active-tables-including-parents ()
+ "Return a list of all active abbrev tables, including parent tables."
+ (let* ((tables (abbrev--active-tables))
+ (all tables))
+ (dolist (table tables)
+ (setq all (append (abbrev-table-get table :parents) all)))
+ all))
+
+(defun abbrev--suggest-get-active-abbrev-expansions ()
+ "Return a list of all the active abbrev expansions.
+Includes expansions from parent abbrev tables."
+ (let (expansions)
+ (dolist (table (abbrev--suggest-get-active-tables-including-parents))
+ (mapatoms (lambda (e)
+ (let ((value (symbol-value (abbrev--symbol e table))))
+ (when value
+ (push (cons value (symbol-name e)) expansions))))
+ table))
+ expansions))
+
+(defun abbrev--suggest-count-words (expansion)
+ "Return the number of words in EXPANSION.
+Expansion is a string of one or more words."
+ (length (split-string expansion " " t)))
+
+(defun abbrev--suggest-get-previous-words (n)
+ "Return the N words before point, spaces included."
+ (let ((end (point)))
+ (save-excursion
+ (backward-word n)
+ (replace-regexp-in-string
+ "\\s " " "
+ (buffer-substring-no-properties (point) end)))))
+
+(defun abbrev--suggest-above-threshold (expansion)
+ "Return non-nil if the abbrev in EXPANSION provides significant savings.
+A significant saving, here, is the difference in length between
+the abbrev and the abbrev expansion. EXPANSION is a cons cell
+where the car is the expansion and the cdr is the abbrev."
+ (>= (- (length (car expansion))
+ (length (cdr expansion)))
+ abbrev-suggest-hint-threshold))
+
+(defvar abbrev--suggest-saved-recommendations nil
+ "Keeps a list of expansions that have abbrevs defined.
+The user can show this list by calling
+`abbrev-suggest-show-report'.")
+
+(defun abbrev--suggest-inform-user (expansion)
+ "Display a message to the user about the existing abbrev.
+EXPANSION is a cons cell where the `car' is the expansion and the
+`cdr' is the abbrev."
+ (run-with-idle-timer
+ 1 nil
+ (lambda ()
+ (message "You can write `%s' using the abbrev `%s'."
+ (car expansion) (cdr expansion))))
+ (push expansion abbrev--suggest-saved-recommendations))
+
+(defun abbrev--suggest-shortest-abbrev (new current)
+ "Return the shortest abbrev of NEW and CURRENT.
+NEW and CURRENT are cons cells where the `car' is the expansion
+and the `cdr' is the abbrev."
+ (if (not current)
+ new
+ (if (< (length (cdr new))
+ (length (cdr current)))
+ new
+ current)))
+
+(defun abbrev--suggest-maybe-suggest ()
+ "Suggest an abbrev to the user based on the word(s) before point.
+Uses `abbrev-suggest-hint-threshold' to find out if the user should be
+informed about the existing abbrev."
+ (let (words abbrev-found word-count)
+ (dolist (expansion (abbrev--suggest-get-active-abbrev-expansions))
+ (setq word-count (abbrev--suggest-count-words (car expansion))
+ words (abbrev--suggest-get-previous-words word-count))
+ (let ((case-fold-search t))
+ (when (and (> word-count 0)
+ (string-match (car expansion) words)
+ (abbrev--suggest-above-threshold expansion))
+ (setq abbrev-found (abbrev--suggest-shortest-abbrev
+ expansion abbrev-found)))))
+ (when abbrev-found
+ (abbrev--suggest-inform-user abbrev-found))))
+
+(defun abbrev--suggest-get-totals ()
+ "Return a list of all expansions and how many times they were used.
+Each expansion is a cons cell where the `car' is the expansion
+and the `cdr' is the number of times the expansion has been
+typed."
+ (let (total cell)
+ (dolist (expansion abbrev--suggest-saved-recommendations)
+ (if (not (assoc (car expansion) total))
+ (push (cons (car expansion) 1) total)
+ (setq cell (assoc (car expansion) total))
+ (setcdr cell (1+ (cdr cell)))))
+ total))
+
+(defun abbrev-suggest-show-report ()
+ "Show a buffer with the list of abbrevs you could have used.
+This shows the abbrevs you've \"missed\" because you typed the
+full text instead of the abbrevs that expand into that text."
+ (interactive)
+ (let ((totals (abbrev--suggest-get-totals))
+ (buf (get-buffer-create "*abbrev-suggest*")))
+ (set-buffer buf)
+ (erase-buffer)
+ (insert "** Abbrev expansion usage **
+
+Below is a list of expansions for which abbrevs are defined, and
+the number of times the expansion was typed manually. To display
+and edit all abbrevs, type `M-x edit-abbrevs RET'\n\n")
+ (dolist (expansion totals)
+ (insert (format " %s: %d\n" (car expansion) (cdr expansion))))
+ (display-buffer buf)))
+
(defun expand-abbrev ()
"Expand the abbrev before point, if there is an abbrev there.
Effective when explicitly called even when `abbrev-mode' is nil.
-Before doing anything else, runs `pre-abbrev-expand-hook'.
Calls the value of `abbrev-expand-function' with no argument to do
the work, and returns whatever it does. (That return value should
be the abbrev symbol if expansion occurred, else nil.)"
(interactive)
- (run-hooks 'pre-abbrev-expand-hook)
- (funcall abbrev-expand-function))
+ (or (funcall abbrev-expand-function)
+ (if abbrev-suggest
+ (abbrev--suggest-maybe-suggest))))
(defun abbrev--default-expand ()
"Default function to use for `abbrev-expand-function'.
diff --git a/lisp/align.el b/lisp/align.el
index c1a2b691312..b2cab1c1b27 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -129,6 +129,8 @@
"Hook that gets run after the aligner has been loaded."
:type 'hook
:group 'align)
+(make-obsolete-variable 'align-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom align-indent-before-aligning nil
"If non-nil, indent the marked region before aligning it."
@@ -387,7 +389,7 @@ The possible settings for `align-region-separate' are:
(regexp . "\\(^\\s-+[^( \t\n]\\|(\\(\\S-+\\)\\s-+\\)\\S-+\\(\\s-+\\)")
(group . 3)
(modes . align-lisp-modes)
- (run-if . ,(function (lambda () current-prefix-arg))))
+ (run-if . ,(lambda () current-prefix-arg)))
(lisp-alist-dot
(regexp . "\\(\\s-*\\)\\.\\(\\s-*\\)")
@@ -461,7 +463,7 @@ The possible settings for `align-region-separate' are:
(regexp . ",\\(\\s-*\\)[^/ \t\n]")
(repeat . t)
(modes . align-c++-modes)
- (run-if . ,(function (lambda () current-prefix-arg))))
+ (run-if . ,(lambda () current-prefix-arg)))
; (valid
; . ,(function
; (lambda ()
@@ -478,7 +480,7 @@ The possible settings for `align-region-separate' are:
(regexp . ",\\(\\s-*\\)[^# \t\n]")
(repeat . t)
(modes . (append align-perl-modes '(python-mode)))
- (run-if . ,(function (lambda () current-prefix-arg))))
+ (run-if . ,(lambda () current-prefix-arg)))
(c++-comment
(regexp . "\\(\\s-*\\)\\(//.*\\|/\\*.*\\*/\\s-*\\)$")
@@ -1002,9 +1004,8 @@ to be colored."
(completing-read
"Title of rule to highlight: "
(mapcar
- (function
- (lambda (rule)
- (list (symbol-name (car rule)))))
+ (lambda (rule)
+ (list (symbol-name (car rule))))
(append (or align-mode-rules-list align-rules-list)
(or align-mode-exclude-rules-list
align-exclude-rules-list))) nil t)))
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index fbdddca7d76..7e7957762ba 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -207,22 +207,8 @@ See `allout-widgets-mode' for allout widgets mode features."
:version "24.1"
:type 'plist
:group 'allout-widgets)
+(make-obsolete-variable 'allout-widgets-item-image-properties-xemacs nil "28.1")
;;;_ . Developer
-;;;_ = allout-widgets-run-unit-tests-on-load
-(defcustom allout-widgets-run-unit-tests-on-load nil
- "When non-nil, unit tests will be run at end of loading allout-widgets.
-
-Generally, allout widgets code developers are the only ones who'll want to
-set this.
-
-\(If set, this makes it an even better practice to exercise changes by
-doing byte-compilation with a repeat count, so the file is loaded after
-compilation.)
-
-See `allout-widgets-run-unit-tests' to see what's run."
- :version "24.1"
- :type 'boolean
- :group 'allout-widgets-developer)
;;;_ = allout-widgets-time-decoration-activity
(defcustom allout-widgets-time-decoration-activity nil
"Retain timing info of the last cooperative redecoration.
@@ -323,8 +309,7 @@ In addition, you can invoked `allout-widgets-mode' allout-mode
buffers where this is set to enable and disable widget
enhancements, directly.")
;;;###autoload
-(put 'allout-widgets-mode-inhibit 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp)
(make-variable-buffer-local 'allout-widgets-mode-inhibit)
;;;_ = allout-inhibit-body-modification-hook
(defvar allout-inhibit-body-modification-hook nil
@@ -415,15 +400,17 @@ not altered with an escape sequence.")
;;;_ , Widget element formatting
;;;_ = allout-item-icon-keymap
(defvar allout-item-icon-keymap
- (let ((km (make-sparse-keymap)))
+ (let ((km (make-sparse-keymap))
+ (as-parent (if (current-local-map)
+ (make-composed-keymap (current-local-map)
+ (current-global-map))
+ (current-global-map))))
+ ;; The keymap parent is reset on the each local var when mode starts.
+ (set-keymap-parent km as-parent)
(dolist (digit '("0" "1" "2" "3"
"4" "5" "6" "7" "8" "9"))
(define-key km digit 'digit-argument))
(define-key km "-" 'negative-argument)
-;; (define-key km [(return)] 'allout-tree-expand-command)
-;; (define-key km [(meta return)] 'allout-toggle-torso-command)
-;; (define-key km [(down-mouse-1)] 'allout-item-button-click)
-;; (define-key km [(down-mouse-2)] 'allout-toggle-torso-event-command)
;; Override underlying mouse-1 and mouse-2 bindings in icon territory:
(define-key km [(mouse-1)] (lambda () (interactive) nil))
(define-key km [(mouse-2)] (lambda () (interactive) nil))
@@ -433,17 +420,16 @@ not altered with an escape sequence.")
km)
"General tree-node key bindings.")
+(make-variable-buffer-local 'allout-item-icon-keymap)
;;;_ = allout-item-body-keymap
(defvar allout-item-body-keymap
(let ((km (make-sparse-keymap))
- (local-map (current-local-map)))
-;; (define-key km [(control return)] 'allout-tree-expand-command)
-;; (define-key km [(meta return)] 'allout-toggle-torso-command)
- ;; XXX We need to reset this per buffer's mode; we do so in
- ;; allout-widgets-mode.
- (if local-map
- (set-keymap-parent km local-map))
-
+ (as-parent (if (current-local-map)
+ (make-composed-keymap (current-local-map)
+ (current-global-map))
+ (current-global-map))))
+ ;; The keymap parent is reset on the each local var when mode starts.
+ (set-keymap-parent km as-parent)
km)
"General key bindings for the text content of outline items.")
(make-variable-buffer-local 'allout-item-body-keymap)
@@ -456,6 +442,7 @@ not altered with an escape sequence.")
(set-keymap-parent km allout-item-icon-keymap)
km)
"Keymap used in the item cue area - the space between the icon and headline.")
+(make-variable-buffer-local 'allout-cue-span-keymap)
;;;_ = allout-escapes-category
(defvar allout-escapes-category nil
"Symbol for category of text property used to hide escapes of prefix-like
@@ -566,8 +553,13 @@ outline hot-spot navigation (see `allout-mode')."
(add-to-invisibility-spec '(allout-torso . t))
(add-to-invisibility-spec 'allout-escapes)
- (if (current-local-map)
- (set-keymap-parent allout-item-body-keymap (current-local-map)))
+ (let ((as-parent (if (current-local-map)
+ (make-composed-keymap (current-local-map)
+ (current-global-map))
+ (current-global-map))))
+ (set-keymap-parent allout-item-body-keymap as-parent)
+ ;; allout-cue-span-keymap uses allout-item-icon-keymap as parent.
+ (set-keymap-parent allout-item-icon-keymap as-parent))
(add-hook 'allout-exposure-change-functions
'allout-widgets-exposure-change-recorder nil 'local)
@@ -677,7 +669,7 @@ outline hot-spot navigation (see `allout-mode')."
(setplist 'allout-cue-span-category nil)
(put 'allout-cue-span-category 'evaporate t)
(put 'allout-cue-span-category
- 'modification-hooks '(allout-body-modification-handler))
+ 'modification-hooks '(allout-graphics-modification-handler))
(put 'allout-cue-span-category 'local-map allout-cue-span-keymap)
(put 'allout-cue-span-category 'mouse-face widget-button-face)
(put 'allout-cue-span-category 'pointer 'arrow)
@@ -924,15 +916,15 @@ posting threshold criteria."
(let ((min (point-max))
(max 0)
first second)
- (mapc (function (lambda (entry)
- (if (eq :undone-exposure (car entry))
- nil
- (setq first (cadr entry)
- second (caddr entry))
- (if (< (min first second) min)
- (setq min (min first second)))
- (if (> (max first second) max)
- (setq max (max first second))))))
+ (mapc (lambda (entry)
+ (if (eq :undone-exposure (car entry))
+ nil
+ (setq first (cadr entry)
+ second (caddr entry))
+ (if (< (min first second) min)
+ (setq min (min first second)))
+ (if (> (max first second) max)
+ (setq max (max first second)))))
allout-widgets-changes-record)
(> (- max min) allout-widgets-adjust-message-size-threshold)))
(let ((prior (current-message)))
@@ -983,11 +975,12 @@ Records changes in `allout-widgets-changes-record'."
Generally invoked via `allout-exposure-change-functions'."
- (let ((changes (sort changes (function (lambda (this next)
- (< (cadr this) (cadr next))))))
+ (let ((changes (sort changes (lambda (this next)
+ (< (cadr this) (cadr next)))))
;; have to distinguish between concealing and exposing so that, eg,
;; `allout-expose-topic's mix is handled properly.
handled-expose
+ handled-conceal
covered
deactivate-mark)
@@ -1345,64 +1338,6 @@ FROM and TO must be in increasing order, as must be the pairs in RANGES."
(setq new-ranges (nreverse new-ranges))
(if ranges (setq new-ranges (append new-ranges ranges)))
(list (if included-from t) new-ranges)))
-;;;_ > allout-test-range-overlaps ()
-(defun allout-test-range-overlaps ()
- "`allout-range-overlaps' unit tests."
- (let* (ranges
- got
- (try (lambda (from to)
- (setq got (allout-range-overlaps from to ranges))
- (setq ranges (cadr got))
- got)))
-;; ;; biggie:
-;; (setq ranges nil)
-;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall
-;; ;; ~ 13 seconds for doing repeated funcall
-;; (message "time-trial: %s, resulting size %s"
-;; (time-trial
-;; '(let ((size 10000)
-;; doing)
-;; (dotimes (count size)
-;; (setq doing (random size))
-;; (funcall try doing (+ doing (random 5)))
-;; ;;(list doing (+ doing (random 5)))
-;; )))
-;; (length ranges))
-;; (sit-for 2)
-
- ;; fresh:
- (setq ranges nil)
- (cl-assert (equal (funcall try 3 5) '(nil ((3 5)))))
- ;; add range at end:
- (cl-assert (equal (funcall try 10 12) '(nil ((3 5) (10 12)))))
- ;; add range at beginning:
- (cl-assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12)))))
- ;; insert range somewhere in the middle:
- (cl-assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12)))))
- ;; consolidate some:
- (cl-assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12)))))
- ;; add more:
- (cl-assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17)))))
- ;; add more:
- (cl-assert (equal (funcall try 20 22)
- '(nil ((1 2) (3 9) (10 12) (15 17) (20 22)))))
- ;; encompass more:
- (cl-assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22)))))
- ;; encompass all:
- (cl-assert (equal (funcall try 2 25) '(t ((1 25)))))
-
- ;; fresh slate:
- (setq ranges nil)
- (cl-assert (equal (funcall try 20 25) '(nil ((20 25)))))
- (cl-assert (equal (funcall try 30 35) '(nil ((20 25) (30 35)))))
- (cl-assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35)))))
- (cl-assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35)))))
- (cl-assert (equal (funcall try 10 30) '(t ((10 35)))))
- (cl-assert (equal (funcall try 5 6) '(nil ((5 6) (10 35)))))
- (cl-assert (equal (funcall try 2 100) '(t ((2 100)))))
-
- (setq ranges nil)
- ))
;;;_ > allout-widgetize-buffer (&optional doing)
(defun allout-widgetize-buffer (&optional doing)
"EXAMPLE FUNCTION. Widgetize items in buffer using allout-chart-subtree.
@@ -1502,8 +1437,7 @@ recursive operation."
;; the actual location of the item text:
:location 'allout-item-location
- :button-keymap allout-item-icon-keymap ; XEmacs
- :keymap allout-item-icon-keymap ; Emacs
+ :keymap allout-item-icon-keymap
;; Element regions:
:guides-span nil
@@ -1594,7 +1528,10 @@ We return the item-widget corresponding to the item at point."
(if is-container
(progn (widget-put item-widget :is-container t)
(setq reverse-siblings-chart (list 1)))
- (goto-char (widget-apply parent :actual-position :from))
+ (let ((parent-position (widget-apply parent
+ :actual-position :from)))
+ (when parent-position
+ (goto-char parent-position)))
(if (widget-get parent :is-container)
;; `allout-goto-prefix' will go to first non-container item:
(allout-goto-prefix)
@@ -1994,8 +1931,7 @@ reapplying this method will rectify the glyphs."
;; NOTE: most of the cue-area
(when (not (widget-get item-widget :is-container))
- (let* ((cue-start (or (widget-get item-widget :distinctive-end)
- (widget-get item-widget :icon-end)))
+ (let* ((cue-start (widget-get item-widget :icon-end))
(body-start (widget-get item-widget :body-start))
;(expanded (widget-get item-widget :expanded))
;(has-subitems (widget-get item-widget :has-subitems))
@@ -2050,19 +1986,22 @@ Optional FORCE means force reassignment of the region property."
;;;_ > allout-widgets-undecorate-region (start end)
(defun allout-widgets-undecorate-region (start end)
"Eliminate widgets and decorations for all items in region from START to END."
- (let ((next start)
- widget)
+ (let (done next widget
+ (end (or end (point-max))))
(save-excursion
(goto-char start)
- (while (< (setq next (next-single-char-property-change next
- 'display
- (current-buffer)
- end))
- end)
- (goto-char next)
- (when (setq widget (allout-get-item-widget))
- ;; if the next-property/overly progression got us to a widget:
- (allout-widgets-undecorate-item widget t))))))
+ (while (not done)
+ (when (and (allout-on-current-heading-p)
+ (setq widget (allout-get-item-widget)))
+ (if widget
+ (allout-widgets-undecorate-item widget t)))
+ (goto-char (setq next
+ (next-single-char-property-change (point)
+ 'display
+ (current-buffer)
+ end)))
+ (if (>= next end)
+ (setq done t))))))
;;;_ > allout-widgets-undecorate-text (text)
(defun allout-widgets-undecorate-text (text)
"Eliminate widgets and decorations for all items in TEXT."
@@ -2316,15 +2255,13 @@ We use a caching strategy, so the caller doesn't need to do so."
(allout-widgets-copy-list (cadr got))
(while (and types (not got))
(setq got
- (allout-find-image
+ (find-image
(list (append (list :type (car types)
:file (concat use-dir
(symbol-name name)
"." (symbol-name
(car types))))
- (if (featurep 'xemacs)
- allout-widgets-item-image-properties-xemacs
- allout-widgets-item-image-properties-emacs)
+ allout-widgets-item-image-properties-emacs
))))
(setq types (cdr types)))
(if got
@@ -2345,11 +2282,7 @@ We use a caching strategy, so the caller doesn't need to do so."
'frame-property)
(t nil)))
;;;_ > allout-find-image (specs)
-(defalias 'allout-find-image
- (if (fboundp 'find-image)
- 'find-image
- nil) ; aka, not-yet-implemented for xemacs.
-)
+(define-obsolete-function-alias 'allout-find-image #'find-image "28.1")
;;;_ > allout-widgets-copy-list (list)
(defun allout-widgets-copy-list (list)
;; duplicated from cl.el 'copy-list' as of 2008-08-17
@@ -2368,28 +2301,16 @@ The elements of LIST are not copied, just the list structure itself."
end (or end (point-max)))
(if (> start end) (let ((interim start)) (setq start end end interim)))
(let ((button-overlays (delq nil
- (mapcar (function (lambda (o)
- (if (overlay-get o 'button)
- o)))
+ (mapcar (lambda (o)
+ (if (overlay-get o 'button)
+ o))
(overlays-in start end)))))
(length button-overlays)))
-;;;_ : Run unit tests:
-(defun allout-widgets-run-unit-tests ()
- (message "Running allout-widget tests...")
-
- (allout-test-range-overlaps)
-
- (message "Running allout-widget tests... Done.")
- (sit-for .5))
-
-(when allout-widgets-run-unit-tests-on-load
- (allout-widgets-run-unit-tests))
-
;;;_ : provide
(provide 'allout-widgets)
-;;;_. Local emacs vars.
-;;;_ , Local variables:
-;;;_ , allout-layout: (-1 : 0)
-;;;_ , End:
+;;;_ . Local emacs vars.
+;;;_ , Local variables:
+;;;_ , allout-layout: (-1 : 0)
+;;;_ , End:
diff --git a/lisp/allout.el b/lisp/allout.el
index 6a7ecbb1ef1..b56071de59e 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -62,8 +62,7 @@
;; The outline menubar additions provide quick reference to many of the
;; features. See the docstring of the variables `allout-layout' and
;; `allout-auto-activation' for details on automatic activation of
-;; `allout-mode' as a minor mode. (`allout-init' is deprecated in favor of
-;; a purely customization-based method.)
+;; `allout-mode' as a minor mode.
;;
;; Note -- the lines beginning with `;;;_' are outline topic headers.
;; Customize `allout-auto-activation' to enable, then revisit this
@@ -78,7 +77,6 @@
;;;_* Dependency loads
(require 'overlay)
-(eval-when-compile (require 'cl-lib))
;;;_* USER CUSTOMIZATION VARIABLES:
@@ -410,8 +408,7 @@ where auto-fill occurs."
:group 'allout)
(make-variable-buffer-local 'allout-use-hanging-indents)
;;;###autoload
-(put 'allout-use-hanging-indents 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-use-hanging-indents 'safe-local-variable 'booleanp)
;;;_ = allout-reindent-bodies
(defcustom allout-reindent-bodies (if allout-use-hanging-indents
'text)
@@ -440,8 +437,7 @@ just the header."
:group 'allout)
(make-variable-buffer-local 'allout-show-bodies)
;;;###autoload
-(put 'allout-show-bodies 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-show-bodies 'safe-local-variable 'booleanp)
;;;_ = allout-beginning-of-line-cycles
(defcustom allout-beginning-of-line-cycles t
@@ -662,8 +658,7 @@ are always respected by the topic maneuvering functions."
:group 'allout)
(make-variable-buffer-local 'allout-old-style-prefixes)
;;;###autoload
-(put 'allout-old-style-prefixes 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-old-style-prefixes 'safe-local-variable 'booleanp)
;;;_ = allout-stylish-prefixes -- alternating bullets
(defcustom allout-stylish-prefixes t
"Do fancy stuff with topic prefix bullets according to level, etc.
@@ -711,8 +706,7 @@ is non-nil."
:group 'allout)
(make-variable-buffer-local 'allout-stylish-prefixes)
;;;###autoload
-(put 'allout-stylish-prefixes 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-stylish-prefixes 'safe-local-variable 'booleanp)
;;;_ = allout-numbered-bullet
(defcustom allout-numbered-bullet "#"
@@ -726,10 +720,7 @@ disables numbering maintenance."
:group 'allout)
(make-variable-buffer-local 'allout-numbered-bullet)
;;;###autoload
-(put 'allout-numbered-bullet 'safe-local-variable
- (if (fboundp 'string-or-null-p)
- 'string-or-null-p
- (lambda (x) (or (stringp x) (null x)))))
+(put 'allout-numbered-bullet 'safe-local-variable 'string-or-null-p)
;;;_ = allout-file-xref-bullet
(defcustom allout-file-xref-bullet "@"
"Bullet signifying file cross-references, for `allout-resolve-xref'.
@@ -738,10 +729,7 @@ Set this var to the bullet you want to use for file cross-references."
:type '(choice (const nil) string)
:group 'allout)
;;;###autoload
-(put 'allout-file-xref-bullet 'safe-local-variable
- (if (fboundp 'string-or-null-p)
- 'string-or-null-p
- (lambda (x) (or (stringp x) (null x)))))
+(put 'allout-file-xref-bullet 'safe-local-variable 'string-or-null-p)
;;;_ = allout-presentation-padding
(defcustom allout-presentation-padding 2
"Presentation-format white-space padding factor, for greater indent."
@@ -851,20 +839,6 @@ for restoring when all encryptions are established.")
(defgroup allout-developer nil
"Allout settings developers care about, including topic encryption and more."
:group 'allout)
-;;;_ = allout-run-unit-tests-on-load
-(defcustom allout-run-unit-tests-on-load nil
- "When non-nil, unit tests will be run at end of loading the allout module.
-
-Generally, allout code developers are the only ones who'll want to set this.
-
-\(If set, this makes it an even better practice to exercise changes by
-doing byte-compilation with a repeat count, so the file is loaded after
-compilation.)
-
-See `allout-run-unit-tests' to see what's run."
- :type 'boolean
- :group 'allout-developer)
-
;;;_ + Miscellaneous customization
;;;_ = allout-enable-file-variable-adjustment
@@ -1637,18 +1611,6 @@ non-nil in a lasting way.")
"If t, `allout-mode's last deactivation was deliberate.
So `allout-post-command-business' should not reactivate it...")
(make-variable-buffer-local 'allout-explicitly-deactivated)
-;;;_ > allout-init (mode)
-(defun allout-init (mode)
- "DEPRECATED - configure allout activation by customizing
-`allout-auto-activation'. This function remains around, limited
-from what it did before, for backwards compatibility.
-
-MODE is the activation mode - see `allout-auto-activation' for
-valid values."
- (declare (obsolete allout-auto-activation "23.3"))
- (customize-set-variable 'allout-auto-activation (format "%s" mode))
- (format "%s" mode))
-
;;;_ > allout-setup-menubar ()
(defun allout-setup-menubar ()
"Populate the current buffer's menubar with `allout-mode' stuff."
@@ -1675,10 +1637,8 @@ valid values."
;; least in emacs 21, 22.1, and xemacs 21.4.
(put 'allout-exposure-category 'isearch-open-invisible
'allout-isearch-end-handler)
- (if (featurep 'xemacs)
- (put 'allout-exposure-category 'start-open t)
- (put 'allout-exposure-category 'insert-in-front-hooks
- '(allout-overlay-insert-in-front-handler)))
+ (put 'allout-exposure-category 'insert-in-front-hooks
+ '(allout-overlay-insert-in-front-handler))
(put 'allout-exposure-category 'modification-hooks
'(allout-overlay-interior-modification-handler)))
;;;_ > define-minor-mode allout-mode
@@ -2115,9 +2075,7 @@ internal functions use this feature cohesively bunch changes."
(allout-show-to-offshoot)))
(when (not first)
(setq first (point))))
- (goto-char (if (featurep 'xemacs)
- (next-property-change (1+ (point)) nil end)
- (next-char-property-change (1+ (point)) end))))
+ (goto-char (next-char-property-change (1+ (point)) end)))
(when first
(goto-char first)
(condition-case nil
@@ -2141,18 +2099,7 @@ See `allout-overlay-interior-modification-handler' for details."
(when (and (allout-mode-p) undo-in-progress)
(setq allout-just-did-undo t)
(if (allout-hidden-p)
- (allout-show-children)))
-
- ;; allout-overlay-interior-modification-handler on an overlay handles
- ;; this in other emacs, via `allout-exposure-category's 'modification-hooks.
- (when (and (featurep 'xemacs) (allout-mode-p))
- ;; process all of the pending overlays:
- (save-excursion
- (goto-char beg)
- (let ((overlay (allout-get-invisibility-overlay)))
- (if overlay
- (allout-overlay-interior-modification-handler
- overlay nil beg end nil))))))
+ (allout-show-children))))
;;;_ > allout-isearch-end-handler (&optional overlay)
(defun allout-isearch-end-handler (&optional _overlay)
"Reconcile allout outline exposure on arriving in hidden text after isearch.
@@ -2453,7 +2400,7 @@ Outermost is first."
(progn
(if (and (not (bolp))
(allout-hidden-p (1- (point))))
- (goto-char (allout-previous-single-char-property-change
+ (goto-char (previous-single-char-property-change
(1- (point)) 'invisible)))
(move-beginning-of-line 1))
(allout-depth)
@@ -2499,20 +2446,16 @@ Outermost is first."
(allout-back-to-current-heading)
(allout-end-of-current-line))
(t
- (if (not (allout-mark-active-p))
+ (if (not mark-active)
(push-mark))
(allout-end-of-entry))))))
+
;;;_ > allout-mark-active-p ()
(defun allout-mark-active-p ()
"True if the mark is currently or always active."
- ;; `(cond (boundp...))' (or `(if ...)') invokes special byte-compiler
- ;; provisions, at least in GNU Emacs to prevent warnings about lack of,
- ;; eg, region-active-p.
- (cond ((boundp 'mark-active)
- mark-active)
- ((fboundp 'region-active-p)
- (region-active-p))
- (t)))
+ (declare (obsolete nil "28.1"))
+ mark-active)
+
;;;_ > allout-next-heading ()
(defsubst allout-next-heading ()
"Move to the heading for the topic (possibly invisible) after this one.
@@ -3443,7 +3386,7 @@ Offer one suitable for current depth DEPTH as default."
(format-message
"Select bullet: %s (`%s' default): "
sans-escapes
- (allout-substring-no-properties default-bullet))
+ (substring-no-properties default-bullet))
sans-escapes
t)))
(message "")
@@ -4458,9 +4401,9 @@ Topic exposure is marked with text-properties, to be used by
(if (not (allout-hidden-p))
(setq next
(max (1+ (point))
- (allout-next-single-char-property-change (point)
- 'invisible
- nil end))))
+ (next-single-char-property-change (point)
+ 'invisible
+ nil end))))
(if (or (not next) (eq prev next))
;; still not at start of hidden area -- must not be any left.
(setq done t)
@@ -4499,7 +4442,7 @@ Topic exposure is marked with text-properties, to be used by
(while (not done)
;; at or advance to start of next annotation:
(if (not (get-text-property (point) 'allout-was-hidden))
- (setq next (allout-next-single-char-property-change
+ (setq next (next-single-char-property-change
(point) 'allout-was-hidden nil end)))
(if (or (not next) (eq prev next))
;; no more or not advancing -- must not be any left.
@@ -4510,7 +4453,7 @@ Topic exposure is marked with text-properties, to be used by
;; still not at start of annotation.
(setq done t)
;; advance to just after end of this annotation:
- (setq next (allout-next-single-char-property-change
+ (setq next (next-single-char-property-change
(point) 'allout-was-hidden nil end))
(let ((o (make-overlay prev next nil 'front-advance)))
(overlay-put o 'category 'allout-exposure-category)
@@ -4543,12 +4486,12 @@ however, are left exactly like normal, non-allout-specific yanks."
(interactive "*P")
; Get to beginning, leaving
; region around subject:
- (if (< (allout-mark-marker t) (point))
+ (if (< (mark-marker) (point))
(exchange-point-and-mark))
(save-match-data
(let* ((subj-beg (point))
(into-bol (bolp))
- (subj-end (allout-mark-marker t))
+ (subj-end (mark-marker))
;; 'resituate' if yanking an entire topic into topic header:
(resituate (and (let ((allout-inhibit-aberrance-doublecheck t))
(allout-e-o-prefix-p))
@@ -4642,8 +4585,8 @@ however, are left exactly like normal, non-allout-specific yanks."
t)))
(message ""))))
(if (or into-bol resituate)
- (allout-hide-by-annotation (point) (allout-mark-marker t))
- (allout-deannotate-hidden (allout-mark-marker t) (point)))
+ (allout-hide-by-annotation (point) (mark-marker))
+ (allout-deannotate-hidden (mark-marker) (point)))
(if (not resituate)
(exchange-point-and-mark))
(run-hook-with-args 'allout-structure-added-functions subj-beg subj-end))))
@@ -4752,14 +4695,7 @@ this function."
(when flag
(let ((o (make-overlay from to nil 'front-advance)))
(overlay-put o 'category 'allout-exposure-category)
- (overlay-put o 'evaporate t)
- (when (featurep 'xemacs)
- (let ((props (symbol-plist 'allout-exposure-category)))
- (while props
- (condition-case nil
- ;; as of 2008-02-27, xemacs lacks modification-hooks
- (overlay-put o (pop props) (pop props))
- (error nil))))))
+ (overlay-put o 'evaporate t))
(setq allout-this-command-hid-text t))
(run-hook-with-args 'allout-exposure-change-functions from to flag))
;;;_ > allout-flag-current-subtree (flag)
@@ -5474,11 +5410,9 @@ header and body. The elements of that list are:
(cdr format)))))))
;; Put the list with first at front, to last at back:
(nreverse result))))
-;;;_ > allout-region-active-p ()
-(defmacro allout-region-active-p ()
- (cond ((fboundp 'use-region-p) '(use-region-p))
- ((fboundp 'region-active-p) '(region-active-p))
- (t 'mark-active)))
+
+(define-obsolete-function-alias 'allout-region-active-p 'region-active-p "28.1")
+
;;_ > allout-process-exposed (&optional func from to frombuf
;;; tobuf format)
(defun allout-process-exposed (&optional func from to frombuf tobuf
@@ -5511,7 +5445,7 @@ Defaults:
; defaulting if necessary:
(if (not func) (setq func 'allout-insert-listified))
(if (not (and from to))
- (if (allout-region-active-p)
+ (if (region-active-p)
(setq from (region-beginning) to (region-end))
(setq from (point-min) to (point-max))))
(if frombuf
@@ -5946,7 +5880,7 @@ See `allout-toggle-current-subtree-encryption' for more details."
;; they're encrypted, so the coding system is set to accommodate
;; them.
(setq buffer-file-coding-system
- (allout-select-safe-coding-system subtree-beg subtree-end))
+ (select-safe-coding-system subtree-beg subtree-end))
;; if the coding system for the text being encrypted is different
;; from that prevailing, then there a real risk that the coding
;; system can't be noticed by emacs when the file is visited. to
@@ -6542,204 +6476,15 @@ If BEG is bigger than END we return 0."
(mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char)))
string)))
(define-obsolete-function-alias 'allout-flatten #'flatten-tree "27.1")
-;;;_ : Compatibility:
-;;;_ : xemacs undo-in-progress provision:
-(unless (boundp 'undo-in-progress)
- (defvar undo-in-progress nil
- "Placeholder defvar for XEmacs compatibility from allout.el.")
- (defadvice undo-more (around allout activate)
- ;; This defadvice used only in emacs that lack undo-in-progress, eg xemacs.
- (let ((undo-in-progress t)) ad-do-it)))
-
-;;;_ > allout-mark-marker to accommodate divergent emacsen:
-(defun allout-mark-marker (&optional force buffer)
- "Accommodate the different signature for `mark-marker' across Emacsen.
-
-XEmacs takes two optional args, while Emacs does not,
-so pass them along when appropriate."
- (if (featurep 'xemacs)
- (apply 'mark-marker force buffer)
- (mark-marker)))
-;;;_ > subst-char-in-string if necessary
-(if (not (fboundp 'subst-char-in-string))
- (defun subst-char-in-string (fromchar tochar string &optional inplace)
- "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
-Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> i 0)
- (setq i (1- i))
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr)))
-;;;_ > wholenump if necessary
-(if (not (fboundp 'wholenump))
- (defalias 'wholenump 'natnump))
-;;;_ > remove-overlays if necessary
-(if (not (fboundp 'remove-overlays))
- (defun remove-overlays (&optional beg end name val)
- "Clear BEG and END of overlays whose property NAME has value VAL.
-Overlays might be moved and/or split.
-BEG and END default respectively to the beginning and end of buffer."
- (unless beg (setq beg (point-min)))
- (unless end (setq end (point-max)))
- (if (< end beg)
- (setq beg (prog1 end (setq end beg))))
- (save-excursion
- (dolist (o (overlays-in beg end))
- (when (eq (overlay-get o name) val)
- ;; Either push this overlay outside beg...end
- ;; or split it to exclude beg...end
- ;; or delete it entirely (if it is contained in beg...end).
- (if (< (overlay-start o) beg)
- (if (> (overlay-end o) end)
- (progn
- (move-overlay (copy-overlay o)
- (overlay-start o) beg)
- (move-overlay o end (overlay-end o)))
- (move-overlay o (overlay-start o) beg))
- (if (> (overlay-end o) end)
- (move-overlay o end (overlay-end o))
- (delete-overlay o)))))))
- )
-;;;_ > copy-overlay if necessary -- xemacs ~ 21.4
-(if (not (fboundp 'copy-overlay))
- (defun copy-overlay (o)
- "Return a copy of overlay O."
- (let ((o1 (make-overlay (overlay-start o) (overlay-end o)
- ;; FIXME: there's no easy way to find the
- ;; insertion-type of the two markers.
- (overlay-buffer o)))
- (props (overlay-properties o)))
- (while props
- (overlay-put o1 (pop props) (pop props)))
- o1)))
-;;;_ > add-to-invisibility-spec if necessary -- xemacs ~ 21.4
-(if (not (fboundp 'add-to-invisibility-spec))
- (defun add-to-invisibility-spec (element)
- "Add ELEMENT to `buffer-invisibility-spec'.
-See documentation for `buffer-invisibility-spec' for the kind of elements
-that can be added."
- (if (eq buffer-invisibility-spec t)
- (setq buffer-invisibility-spec (list t)))
- (setq buffer-invisibility-spec
- (cons element buffer-invisibility-spec))))
-;;;_ > remove-from-invisibility-spec if necessary -- xemacs ~ 21.4
-(if (not (fboundp 'remove-from-invisibility-spec))
- (defun remove-from-invisibility-spec (element)
- "Remove ELEMENT from `buffer-invisibility-spec'."
- (if (consp buffer-invisibility-spec)
- (setq buffer-invisibility-spec (delete element
- buffer-invisibility-spec)))))
-;;;_ > move-beginning-of-line if necessary -- older emacs, xemacs
-(if (not (fboundp 'move-beginning-of-line))
- (defun move-beginning-of-line (arg)
- "Move point to beginning of current line as displayed.
-\(This disregards invisible newlines such as those
-which are part of the text that an image rests on.)
-
-With argument ARG not nil or 1, move forward ARG - 1 lines first.
-If point reaches the beginning or end of buffer, it stops there.
-To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
- (interactive "p")
- (or arg (setq arg 1))
- (if (/= arg 1)
- (condition-case nil (line-move (1- arg)) (error nil)))
-
- ;; Move to beginning-of-line, ignoring fields and invisible text.
- (skip-chars-backward "^\n")
- (while (and (not (bobp))
- (let ((prop
- (get-char-property (1- (point)) 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec)))))
- (goto-char (if (featurep 'xemacs)
- (previous-property-change (point))
- (previous-char-property-change (point))))
- (skip-chars-backward "^\n"))
- (vertical-motion 0))
-)
-;;;_ > move-end-of-line if necessary -- Emacs < 22.1, xemacs
-(if (not (fboundp 'move-end-of-line))
- (defun move-end-of-line (arg)
- "Move point to end of current line as displayed.
-\(This disregards invisible newlines such as those
-which are part of the text that an image rests on.)
-
-With argument ARG not nil or 1, move forward ARG - 1 lines first.
-If point reaches the beginning or end of buffer, it stops there.
-To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
- (interactive "p")
- (or arg (setq arg 1))
- (let (done)
- (while (not done)
- (let ((newpos
- (save-excursion
- (let ((goal-column 0))
- (and (condition-case nil
- (or (line-move arg) t)
- (error nil))
- (not (bobp))
- (progn
- (while
- (and
- (not (bobp))
- (let ((prop
- (get-char-property (1- (point))
- 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop
- buffer-invisibility-spec)
- (assq prop
- buffer-invisibility-spec)))))
- (goto-char
- (previous-char-property-change (point))))
- (backward-char 1)))
- (point)))))
- (goto-char newpos)
- (if (and (> (point) newpos)
- (eq (preceding-char) ?\n))
- (backward-char 1)
- (if (and (> (point) newpos) (not (eobp))
- (not (eq (following-char) ?\n)))
- ;; If we skipped something intangible
- ;; and now we're not really at eol,
- ;; keep going.
- (setq arg 1)
- (setq done t)))))))
- )
-;;;_ > allout-next-single-char-property-change -- alias unless lacking
-(defalias 'allout-next-single-char-property-change
- (if (fboundp 'next-single-char-property-change)
- 'next-single-char-property-change
- 'next-single-property-change)
- ;; No docstring because xemacs defalias doesn't support it.
- )
-;;;_ > allout-previous-single-char-property-change -- alias unless lacking
-(defalias 'allout-previous-single-char-property-change
- (if (fboundp 'previous-single-char-property-change)
- 'previous-single-char-property-change
- 'previous-single-property-change)
- ;; No docstring because xemacs defalias doesn't support it.
- )
-;;;_ > allout-select-safe-coding-system
-(defalias 'allout-select-safe-coding-system
- (if (fboundp 'select-safe-coding-system)
- 'select-safe-coding-system
- 'detect-coding-region)
- )
-;;;_ > allout-substring-no-properties
-;; define as alias first, so byte compiler is happy.
-(defalias 'allout-substring-no-properties 'substring-no-properties)
-;; then supplant with definition if underlying alias absent.
-(if (not (fboundp 'substring-no-properties))
- (defun allout-substring-no-properties (string &optional start end)
- (substring string (or start 0) end))
- )
-
+(define-obsolete-function-alias 'allout-mark-marker #'mark-marker "28.1")
+(define-obsolete-function-alias 'allout-substring-no-properties
+ #'substring-no-properties "28.1")
+(define-obsolete-function-alias 'allout-select-safe-coding-system
+ #'select-safe-coding-system "28.1")
+(define-obsolete-function-alias 'allout-previous-single-char-property-change
+ #'previous-single-char-property-change "28.1")
+(define-obsolete-function-alias 'allout-next-single-char-property-change
+ #'next-single-char-property-change "28.1")
;;;_ #10 Unfinished
;;;_ > allout-bullet-isearch (&optional bullet)
(defun allout-bullet-isearch (&optional bullet)
@@ -6758,136 +6503,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
(isearch-repeat 'forward)
(isearch-mode t)))
-;;;_ #11 Unit tests -- this should be last item before "Provide"
-;;;_ > allout-run-unit-tests ()
-(defun allout-run-unit-tests ()
- "Run the various allout unit tests."
- (message "Running allout tests...")
- (allout-test-resumptions)
- (message "Running allout tests... Done.")
- (sit-for .5))
-;;;_ : test resumptions:
-;;;_ > allout-tests-obliterate-variable (name)
-(defun allout-tests-obliterate-variable (name)
- "Completely unbind variable with NAME."
- (if (local-variable-p name (current-buffer)) (kill-local-variable name))
- (while (boundp name) (makunbound name)))
-;;;_ > allout-test-resumptions ()
-(defvar allout-tests-globally-unbound nil
- "Fodder for allout resumptions tests -- defvar just for byte compiler.")
-(defvar allout-tests-globally-true nil
- "Fodder for allout resumptions tests -- defvar just for byte compiler.")
-(defvar allout-tests-locally-true nil
- "Fodder for allout resumptions tests -- defvar just for byte compiler.")
-(defun allout-test-resumptions ()
- ;; FIXME: Use ERT.
- "Exercise allout resumptions."
- ;; for each resumption case, we also test that the right local/global
- ;; scopes are affected during resumption effects:
-
- ;; ensure that previously unbound variables return to the unbound state.
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-add-resumptions '(allout-tests-globally-unbound t))
- (cl-assert (not (default-boundp 'allout-tests-globally-unbound)))
- (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
- (cl-assert (boundp 'allout-tests-globally-unbound))
- (cl-assert (equal allout-tests-globally-unbound t))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-unbound
- (current-buffer))))
- (cl-assert (not (boundp 'allout-tests-globally-unbound))))
-
- ;; ensure that variable with prior global value is resumed
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (setq allout-tests-globally-true t)
- (allout-add-resumptions '(allout-tests-globally-true nil))
- (cl-assert (equal (default-value 'allout-tests-globally-true) t))
- (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
- (cl-assert (equal allout-tests-globally-true nil))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-true
- (current-buffer))))
- (cl-assert (boundp 'allout-tests-globally-true))
- (cl-assert (equal allout-tests-globally-true t)))
-
- ;; ensure that prior local value is resumed
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
- (cl-assert (not (default-boundp 'allout-tests-locally-true))
- nil (concat "Test setup mistake -- variable supposed to"
- " not have global binding, but it does."))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer))
- nil (concat "Test setup mistake -- variable supposed to have"
- " local binding, but it lacks one."))
- (allout-add-resumptions '(allout-tests-locally-true nil))
- (cl-assert (not (default-boundp 'allout-tests-locally-true)))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true nil))
- (allout-do-resumptions)
- (cl-assert (boundp 'allout-tests-locally-true))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true t))
- (cl-assert (not (default-boundp 'allout-tests-locally-true))))
-
- ;; ensure that last of multiple resumptions holds, for various scopes.
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (setq allout-tests-globally-true t)
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
- (allout-add-resumptions '(allout-tests-globally-unbound t)
- '(allout-tests-globally-true nil)
- '(allout-tests-locally-true nil))
- (allout-add-resumptions '(allout-tests-globally-unbound 2)
- '(allout-tests-globally-true 3)
- '(allout-tests-locally-true 4))
- ;; reestablish many of the basic conditions are maintained after re-add:
- (cl-assert (not (default-boundp 'allout-tests-globally-unbound)))
- (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
- (cl-assert (equal allout-tests-globally-unbound 2))
- (cl-assert (default-boundp 'allout-tests-globally-true))
- (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
- (cl-assert (equal allout-tests-globally-true 3))
- (cl-assert (not (default-boundp 'allout-tests-locally-true)))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true 4))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-unbound
- (current-buffer))))
- (cl-assert (not (boundp 'allout-tests-globally-unbound)))
- (cl-assert (not (local-variable-p 'allout-tests-globally-true
- (current-buffer))))
- (cl-assert (boundp 'allout-tests-globally-true))
- (cl-assert (equal allout-tests-globally-true t))
- (cl-assert (boundp 'allout-tests-locally-true))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true t))
- (cl-assert (not (default-boundp 'allout-tests-locally-true))))
-
- ;; ensure that deliberately unbinding registered variables doesn't foul things
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (setq allout-tests-globally-true t)
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable 'allout-tests-locally-true) t)
- (allout-add-resumptions '(allout-tests-globally-unbound t)
- '(allout-tests-globally-true nil)
- '(allout-tests-locally-true nil))
- (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
- (allout-tests-obliterate-variable 'allout-tests-globally-true)
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (allout-do-resumptions))
- )
-;;;_ % Run unit tests if `allout-run-unit-tests-on-load' is true:
-(when allout-run-unit-tests-on-load
- (allout-run-unit-tests))
-
-;;;_ #12 Provide
+;;;_ #11 Provide
(provide 'allout)
;;;_* Local emacs vars.
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 4130f5aad3c..d5432a60fba 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -39,7 +39,7 @@
;;
;; SGR control sequences are defined in section 3.8.117 of the ECMA-48
;; standard (identical to ISO/IEC 6429), which is freely available as a
-;; PDF file <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm>.
+;; PDF file <URL:https://www.ecma-international.org/publications/standards/Ecma-048.htm>.
;; The "Graphic Rendition Combination Mode (GRCM)" implemented is
;; "cumulative mode" as defined in section 7.2.8. Cumulative mode
;; means that whenever possible, SGR control sequences are combined
@@ -84,7 +84,7 @@ This translation effectively colorizes strings and regions based upon
SGR control sequences embedded in the text. SGR (Select Graphic
Rendition) control sequences are defined in section 8.3.117 of the
ECMA-48 standard (identical to ISO/IEC 6429), which is freely available
-at <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm>
+at <URL:https://www.ecma-international.org/publications/standards/Ecma-048.htm>
as a PDF file."
:version "21.1"
:group 'processes)
@@ -363,7 +363,7 @@ it will override BEGIN, the start of the region. Set
(setq ansi-color-context-region (list nil (match-beginning 0)))
(setq ansi-color-context-region nil)))))
-(defun ansi-color-apply-on-region (begin end)
+(defun ansi-color-apply-on-region (begin end &optional preserve-sequences)
"Translates SGR control sequences into overlays or extents.
Delete all other control sequences without processing them.
@@ -380,18 +380,28 @@ ansi codes. This information will be used for the next call to
`ansi-color-apply-on-region'. Specifically, it will override
BEGIN, the start of the region and set the face with which to
start. Set `ansi-color-context-region' to nil if you don't want
-this."
+this.
+
+If PRESERVE-SEQUENCES is t, the sequences are hidden instead of
+being deleted."
(let ((codes (car ansi-color-context-region))
- (start-marker (or (cadr ansi-color-context-region)
- (copy-marker begin)))
- (end-marker (copy-marker end)))
+ (start-marker (or (cadr ansi-color-context-region)
+ (copy-marker begin)))
+ (end-marker (copy-marker end)))
(save-excursion
(goto-char start-marker)
;; Find the next escape sequence.
(while (re-search-forward ansi-color-control-seq-regexp end-marker t)
- ;; Remove escape sequence.
- (let ((esc-seq (delete-and-extract-region
+ ;; Extract escape sequence.
+ (let ((esc-seq (buffer-substring
(match-beginning 0) (point))))
+ (if preserve-sequences
+ ;; Make the escape sequence transparent.
+ (overlay-put (make-overlay (match-beginning 0) (point))
+ 'invisible t)
+ ;; Otherwise, strip.
+ (delete-region (match-beginning 0) (point)))
+
;; Colorize the old block from start to end using old face.
(funcall ansi-color-apply-face-function
(prog1 (marker-position start-marker)
@@ -414,11 +424,17 @@ this."
;; if the rest of the region should have a face, put it there
(funcall ansi-color-apply-face-function
start-marker end-marker (ansi-color--find-face codes))
- (setq ansi-color-context-region (if codes (list codes)))))
+ ;; Save a restart position when there are codes active. It's
+ ;; convenient for man.el's process filter to pass `begin'
+ ;; positions that overlap regions previously colored; these
+ ;; `codes' should not be applied to that overlap, so we need
+ ;; to know where they should really start.
+ (setq ansi-color-context-region (if codes (list codes end-marker)))))
;; Clean up our temporary markers.
(unless (eq start-marker (cadr ansi-color-context-region))
(set-marker start-marker nil))
- (set-marker end-marker nil)))
+ (unless (eq end-marker (cadr ansi-color-context-region))
+ (set-marker end-marker nil))))
(defun ansi-color-apply-overlay-face (beg end face)
"Make an overlay from BEG to END, and apply face FACE.
@@ -536,7 +552,7 @@ codes. Finally, the so changed list of codes is returned."
(cons new (remq new codes))))
(2 (unless (memq new '(20 26 28 29))
;; The standard says `21 doubly underlined' while
- ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims
+ ;; https://en.wikipedia.org/wiki/ANSI_escape_code claims
;; `21 Bright/Bold: off or Underline: Double'.
(remq (- new 20) (pcase new
(22 (remq 1 codes))
@@ -566,27 +582,27 @@ The face definitions are based upon the variables
(index 0))
;; miscellaneous attributes
(mapc
- (function (lambda (e)
- (aset map index e)
- (setq index (1+ index)) ))
+ (lambda (e)
+ (aset map index e)
+ (setq index (1+ index)) )
ansi-color-faces-vector)
;; foreground attributes
(setq index 30)
(mapc
- (function (lambda (e)
- (aset map index
- (ansi-color-make-face 'foreground
- (if (consp e) (car e) e)))
- (setq index (1+ index)) ))
+ (lambda (e)
+ (aset map index
+ (ansi-color-make-face 'foreground
+ (if (consp e) (car e) e)))
+ (setq index (1+ index)) )
ansi-color-names-vector)
;; background attributes
(setq index 40)
(mapc
- (function (lambda (e)
- (aset map index
- (ansi-color-make-face 'background
- (if (consp e) (cdr e) e)))
- (setq index (1+ index)) ))
+ (lambda (e)
+ (aset map index
+ (ansi-color-make-face 'background
+ (if (consp e) (cdr e) e)))
+ (setq index (1+ index)) )
ansi-color-names-vector)
map))
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 23f70d10fd4..9debdfb19ce 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1,4 +1,4 @@
-;;; apropos.el --- apropos commands for users and programmers
+;;; apropos.el --- apropos commands for users and programmers -*- lexical-binding: t -*-
;; Copyright (C) 1989, 1994-1995, 2001-2020 Free Software Foundation,
;; Inc.
@@ -27,8 +27,7 @@
;; The ideas for this package were derived from the C code in
;; src/keymap.c and elsewhere. The functions in this file should
-;; always be byte-compiled for speed. Someone should rewrite this in
-;; C (as part of src/keymap.c) for speed.
+;; always be byte-compiled for speed.
;; The idea for super-apropos is based on the original implementation
;; by Lynn Slater <lrs@esl.com>.
@@ -82,49 +81,41 @@ commands also has an optional argument to request a more extensive search.
Additionally, this option makes the function `apropos-library'
include key-binding information in its output."
- :group 'apropos
:type 'boolean)
(defface apropos-symbol
'((t (:inherit bold)))
"Face for the symbol name in Apropos output."
- :group 'apropos
:version "24.3")
(defface apropos-keybinding
'((t (:inherit underline)))
"Face for lists of keybinding in Apropos output."
- :group 'apropos
:version "24.3")
(defface apropos-property
'((t (:inherit font-lock-builtin-face)))
"Face for property name in Apropos output, or nil for none."
- :group 'apropos
:version "24.3")
(defface apropos-function-button
'((t (:inherit (font-lock-function-name-face button))))
"Button face indicating a function, macro, or command in Apropos."
- :group 'apropos
:version "24.3")
(defface apropos-variable-button
'((t (:inherit (font-lock-variable-name-face button))))
"Button face indicating a variable in Apropos."
- :group 'apropos
:version "24.3")
(defface apropos-user-option-button
'((t (:inherit (font-lock-variable-name-face button))))
"Button face indicating a user option in Apropos."
- :group 'apropos
:version "24.4")
(defface apropos-misc-button
'((t (:inherit (font-lock-constant-face button))))
"Button face indicating a miscellaneous object type in Apropos."
- :group 'apropos
:version "24.3")
(defcustom apropos-match-face 'match
@@ -132,14 +123,12 @@ include key-binding information in its output."
This applies when you look for matches in the documentation or variable value
for the pattern; the part that matches gets displayed in this font."
:type '(choice (const nil) face)
- :group 'apropos
:version "24.3")
(defcustom apropos-sort-by-scores nil
"Non-nil means sort matches by scores; best match is shown first.
This applies to all `apropos' commands except `apropos-documentation'.
If value is `verbose', the computed score is shown for each match."
- :group 'apropos
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
(const :tag "show scores" verbose)))
@@ -148,7 +137,6 @@ If value is `verbose', the computed score is shown for each match."
"Non-nil means sort matches by scores; best match is shown first.
This applies to `apropos-documentation' only.
If value is `verbose', the computed score is shown for each match."
- :group 'apropos
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
(const :tag "show scores" verbose)))
@@ -160,6 +148,10 @@ If value is `verbose', the computed score is shown for each match."
;; definition of RET, so that users can use it anywhere in an
;; apropos item, not just on top of a button.
(define-key map "\C-m" 'apropos-follow)
+
+ ;; Movement keys
+ (define-key map "n" 'apropos-next-symbol)
+ (define-key map "p" 'apropos-previous-symbol)
map)
"Keymap used in Apropos mode.")
@@ -348,7 +340,7 @@ before finding a label."
(defun apropos-words-to-regexp (words wild)
- "Make regexp matching any two of the words in WORDS.
+ "Return a regexp matching any two of the words in WORDS.
WILD should be a subexpression matching wildcards between matches."
(setq words (delete-dups (copy-sequence words)))
(if (null (cdr words))
@@ -380,9 +372,11 @@ kind of objects to search."
(user-error "No word list given"))
pattern)))
-(defun apropos-parse-pattern (pattern)
+(defun apropos-parse-pattern (pattern &optional multiline-p)
"Rewrite a list of words to a regexp matching all permutations.
If PATTERN is a string, that means it is already a regexp.
+MULTILINE-P, if non-nil, means produce a regexp that will match
+the words even if separated by newlines.
This updates variables `apropos-pattern', `apropos-pattern-quoted',
`apropos-regexp', `apropos-words', and `apropos-all-words-regexp'."
(setq apropos-words nil
@@ -393,6 +387,9 @@ This updates variables `apropos-pattern', `apropos-pattern-quoted',
;; any combination of two or more words like this:
;; (a|b|c).*(a|b|c) which may give some false matches,
;; but as long as it also gives the right ones, that's ok.
+ ;; (Actually, when MULTILINE-P is non-nil, instead of '.' we
+ ;; use a trick that would find a match even if the words are
+ ;; on different lines.
(let ((words pattern))
(setq apropos-pattern (mapconcat 'identity pattern " ")
apropos-pattern-quoted (regexp-quote apropos-pattern))
@@ -409,9 +406,13 @@ This updates variables `apropos-pattern', `apropos-pattern-quoted',
(setq apropos-words (cons s apropos-words)
apropos-all-words (cons a apropos-all-words))))
(setq apropos-all-words-regexp
- (apropos-words-to-regexp apropos-all-words ".+"))
+ (apropos-words-to-regexp apropos-all-words
+ ;; The [^b-a] trick matches any
+ ;; character including a newline.
+ (if multiline-p "[^b-a]+?" ".+")))
(setq apropos-regexp
- (apropos-words-to-regexp apropos-words ".*?")))
+ (apropos-words-to-regexp apropos-words
+ (if multiline-p "[^b-a]*?" ".*?"))))
(setq apropos-pattern-quoted (regexp-quote pattern)
apropos-all-words-regexp pattern
apropos-pattern pattern
@@ -541,6 +542,20 @@ will be buffer-local when set."
(and (local-variable-if-set-p symbol)
(get symbol 'variable-documentation)))))
+;;;###autoload
+(defun apropos-function (pattern)
+ "Show functions that match PATTERN.
+
+PATTERN can be a word, a list of words (separated by spaces),
+or a regexp (using some regexp special characters). If it is a word,
+search for matches for that word as a substring. If it is a list of words,
+search for matches for any two (or more) of those words.
+
+This is the same as running `apropos-command' with a \\[universal-argument] prefix,
+or a non-nil `apropos-do-all' argument."
+ (interactive (list (apropos-read-pattern "function")))
+ (apropos-command pattern t))
+
;; For auld lang syne:
;;;###autoload
(defalias 'command-apropos 'apropos-command)
@@ -640,7 +655,7 @@ search for matches for any two (or more) of those words.
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil,
consider all symbols (if they match PATTERN).
-Returns list of symbols and documentation found."
+Return list of symbols and documentation found."
(interactive (list (apropos-read-pattern "symbol")
current-prefix-arg))
(setq apropos--current (list #'apropos pattern do-all))
@@ -659,12 +674,11 @@ Returns list of symbols and documentation found."
(defun apropos-library-button (sym)
(if (null sym)
"<nothing>"
- (let ((name (copy-sequence (symbol-name sym))))
+ (let ((name (symbol-name sym)))
(make-text-button name nil
'type 'apropos-library
'face 'apropos-symbol
- 'apropos-symbol name)
- name)))
+ 'apropos-symbol name))))
;;;###autoload
(defun apropos-library (file)
@@ -794,7 +808,7 @@ Returns list of symbols and values found."
(interactive (list (apropos-read-pattern "value")
current-prefix-arg))
(setq apropos--current (list #'apropos-value pattern do-all))
- (apropos-parse-pattern pattern)
+ (apropos-parse-pattern pattern t)
(or do-all (setq do-all apropos-do-all))
(setq apropos-accumulator ())
(let (f v p)
@@ -834,7 +848,7 @@ Optional arg BUFFER (default: current buffer) is the buffer to check."
(interactive (list (apropos-read-pattern "value of buffer-local variable")))
(unless buffer (setq buffer (current-buffer)))
(setq apropos--current (list #'apropos-local-value pattern buffer))
- (apropos-parse-pattern pattern)
+ (apropos-parse-pattern pattern t)
(setq apropos-accumulator ())
(let ((var nil))
(mapatoms
@@ -848,14 +862,12 @@ Optional arg BUFFER (default: current buffer) is the buffer to check."
(setq apropos-accumulator (cons (list symb (apropos-score-str var) nil var)
apropos-accumulator))))))
(let ((apropos-multi-type nil))
- (if (> emacs-major-version 20)
- (apropos-print
- nil "\n----------------\n"
- (format "Buffer `%s' has the following local variables\nmatching %s`%s':"
- (buffer-name buffer)
- (if (consp pattern) "keywords " "")
- pattern))
- (apropos-print nil "\n----------------\n"))))
+ (apropos-print
+ nil "\n----------------\n"
+ (format "Buffer `%s' has the following local variables\nmatching %s`%s':"
+ (buffer-name buffer)
+ (if (consp pattern) "keywords " "")
+ pattern))))
;;;###autoload
(defun apropos-documentation (pattern &optional do-all)
@@ -876,7 +888,7 @@ Returns list of symbols and documentation found."
(interactive (list (apropos-read-pattern "documentation")
current-prefix-arg))
(setq apropos--current (list #'apropos-documentation pattern do-all))
- (apropos-parse-pattern pattern)
+ (apropos-parse-pattern pattern t)
(or do-all (setq do-all apropos-do-all))
(setq apropos-accumulator () apropos-files-scanned ())
(let ((standard-input (get-buffer-create " apropos-temp"))
@@ -917,16 +929,14 @@ Returns list of symbols and documentation found."
(defun apropos-value-internal (predicate symbol function)
- (if (funcall predicate symbol)
- (progn
- (setq symbol (prin1-to-string (funcall function symbol)))
- (if (string-match apropos-regexp symbol)
- (progn
- (if apropos-match-face
- (put-text-property (match-beginning 0) (match-end 0)
- 'face apropos-match-face
- symbol))
- symbol)))))
+ (when (funcall predicate symbol)
+ (setq symbol (prin1-to-string (funcall function symbol)))
+ (when (string-match apropos-regexp symbol)
+ (if apropos-match-face
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face apropos-match-face
+ symbol))
+ symbol)))
(defun apropos-documentation-internal (doc)
(cond
@@ -948,6 +958,10 @@ Returns list of symbols and documentation found."
doc))))
(defun apropos-format-plist (pl sep &optional compare)
+ "Return a string representation of the plist PL.
+Paired elements are separated by the string SEP. Only include
+properties matching the current `apropos-regexp' when COMPARE is
+non-nil."
(setq pl (symbol-plist pl))
(let (p p-out)
(while pl
@@ -956,13 +970,12 @@ Returns list of symbols and documentation found."
(put-text-property 0 (length (symbol-name (car pl)))
'face 'apropos-property p)
(setq p nil))
- (if p
- (progn
- (and compare apropos-match-face
- (put-text-property (match-beginning 0) (match-end 0)
- 'face apropos-match-face
- p))
- (setq p-out (concat p-out (if p-out sep) p))))
+ (when p
+ (and compare apropos-match-face
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face apropos-match-face
+ p))
+ (setq p-out (concat p-out (if p-out sep) p)))
(setq pl (nthcdr 2 pl)))
p-out))
@@ -1270,6 +1283,21 @@ as a heading."
(or (apropos-next-label-button (line-beginning-position))
(error "There is nothing to follow here"))))
+(defun apropos-next-symbol ()
+ "Move cursor down to the next symbol in an apropos-mode buffer."
+ (interactive)
+ (forward-line)
+ (while (and (not (eq (face-at-point) 'apropos-symbol))
+ (< (point) (point-max)))
+ (forward-line)))
+
+(defun apropos-previous-symbol ()
+ "Move cursor back to the last symbol in an apropos-mode buffer."
+ (interactive)
+ (forward-line -1)
+ (while (and (not (eq (face-at-point) 'apropos-symbol))
+ (> (point) (point-min)))
+ (forward-line -1)))
(defun apropos-describe-plist (symbol)
"Display a pretty listing of SYMBOL's plist."
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index c09f78e0d24..ce0c061fc09 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1,4 +1,4 @@
-;;; arc-mode.el --- simple editing of archives
+;;; arc-mode.el --- simple editing of archives -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997-1998, 2001-2020 Free Software Foundation,
;; Inc.
@@ -41,8 +41,7 @@
;; changes will first take effect when the archive buffer
;; is saved. You will be warned about this.
;;
-;; * dos-fns.el: (Part of Emacs 19). You get automatic ^M^J <--> ^J
-;; conversion.
+;; * dos-fns.el: You get automatic ^M^J <--> ^J conversion.
;;
;; arc-mode.el does not work well with crypt++.el; for the archives as
;; such this could be fixed (but wouldn't be useful) by declaring such
@@ -52,17 +51,17 @@
;; ARCHIVE TYPES: Currently only the archives below are handled, but the
;; structure for handling just about anything is in place.
;;
-;; Arc Lzh Zip Zoo Rar 7z
-;; --------------------------------------------
-;; View listing Intern Intern Intern Intern Y Y
-;; Extract member Y Y Y Y Y Y
-;; Save changed member Y Y Y Y N Y
-;; Add new member N N N N N N
-;; Delete member Y Y Y Y N Y
-;; Rename member Y Y N N N N
-;; Chmod - Y Y - N N
-;; Chown - Y - - N N
-;; Chgrp - Y - - N N
+;; Arc Lzh Zip Zoo Rar 7z Ar Squashfs
+;; ---------------------------------------------------------------
+;; View listing Intern Intern Intern Intern Y Y Y Y
+;; Extract member Y Y Y Y Y Y Y Y
+;; Save changed member Y Y Y Y N Y Y N
+;; Add new member N N N N N N N N
+;; Delete member Y Y Y Y N Y N N
+;; Rename member Y Y N N N N N N
+;; Chmod - Y Y - N N N N
+;; Chown - Y - - N N N N
+;; Chgrp - Y - - N N N N
;;
;; Special thanks to Bill Brodie <wbrodie@panix.com> for very useful tips
;; on the first released version of this package.
@@ -101,6 +100,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
;; -------------------------------------------------------------------------
;;; Section: Configuration.
@@ -108,22 +109,6 @@
"Simple editing of archives."
:group 'data)
-(defgroup archive-arc nil
- "ARC-specific options to archive."
- :group 'archive)
-
-(defgroup archive-lzh nil
- "LZH-specific options to archive."
- :group 'archive)
-
-(defgroup archive-zip nil
- "ZIP-specific options to archive."
- :group 'archive)
-
-(defgroup archive-zoo nil
- "ZOO-specific options to archive."
- :group 'archive)
-
(defcustom archive-tmpdir
;; make-temp-name is safe here because we use this name
;; to create a directory.
@@ -131,35 +116,48 @@
(expand-file-name (if (eq system-type 'ms-dos) "ar" "archive.tmp")
temporary-file-directory))
"Directory for temporary files made by `arc-mode.el'."
- :type 'directory
- :group 'archive)
+ :type 'directory)
(defcustom archive-remote-regexp "^/[^/:]*[^/:.]:"
"Regexp recognizing archive files names that are not local.
A non-local file is one whose file name is not proper outside Emacs.
A local copy of the archive will be used when updating."
- :type 'regexp
- :group 'archive)
+ :type 'regexp)
(define-obsolete-variable-alias 'archive-extract-hooks
'archive-extract-hook "24.3")
(defcustom archive-extract-hook nil
"Hook run when an archive member has been extracted."
- :type 'hook
- :group 'archive)
+ :type 'hook)
(defcustom archive-visit-single-files nil
"If non-nil, opening an archive with a single file visits that file.
If nil, visiting such an archive displays the archive summary."
:version "25.1"
:type '(choice (const :tag "Visit the single file" t)
- (const :tag "Show the archive summary" nil))
- :group 'archive)
+ (const :tag "Show the archive summary" nil)))
+
+(defcustom archive-hidden-columns '(Ids)
+ "Columns hidden from display."
+ :version "28.1"
+ :type '(set (const Mode)
+ (const Ids)
+ (const Date&Time)
+ (const Ratio)))
+
+(defconst archive-alternate-hidden-columns '(Mode Date&Time)
+ "Columns hidden when `archive-alternate-display' is used.")
+
;; ------------------------------
;; Arc archive configuration
;; We always go via a local file since there seems to be no reliable way
;; to extract to stdout without junk getting added.
+
+(defgroup archive-arc nil
+ "ARC-specific options to archive."
+ :group 'archive)
+
(defcustom archive-arc-extract
'("arc" "x")
"Program and its options to run in order to extract an arc file member.
@@ -168,8 +166,7 @@ name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-arc)
+ (string :format "%v"))))
(defcustom archive-arc-expunge
'("arc" "d")
@@ -178,8 +175,7 @@ Archive and member names will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-arc)
+ (string :format "%v"))))
(defcustom archive-arc-write-file-member
'("arc" "u")
@@ -188,11 +184,14 @@ Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-arc)
+ (string :format "%v"))))
;; ------------------------------
;; Lzh archive configuration
+(defgroup archive-lzh nil
+ "LZH-specific options to archive."
+ :group 'archive)
+
(defcustom archive-lzh-extract
'("lha" "pq")
"Program and its options to run in order to extract an lzh file member.
@@ -201,8 +200,7 @@ be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-lzh)
+ (string :format "%v"))))
(defcustom archive-lzh-expunge
'("lha" "d")
@@ -211,8 +209,7 @@ Archive and member names will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-lzh)
+ (string :format "%v"))))
(defcustom archive-lzh-write-file-member
'("lha" "a")
@@ -221,8 +218,7 @@ Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-lzh)
+ (string :format "%v"))))
;; ------------------------------
;; Zip archive configuration
@@ -231,6 +227,10 @@ Archive and member name will be added."
(when 7z
(file-name-nondirectory 7z))))
+(defgroup archive-zip nil
+ "ZIP-specific options to archive."
+ :group 'archive)
+
(defcustom archive-zip-extract
(cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
(archive-7z-program `(,archive-7z-program "x" "-so"))
@@ -242,8 +242,7 @@ be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zip)
+ (string :format "%v"))))
;; For several reasons the latter behavior is not desirable in general.
;; (1) It uses more disk space. (2) Error checking is worse or non-
@@ -260,8 +259,7 @@ Archive and member names will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zip)
+ (string :format "%v"))))
(defcustom archive-zip-update
(cond ((executable-find "zip") '("zip" "-q"))
@@ -274,8 +272,7 @@ file. Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zip)
+ (string :format "%v"))))
(defcustom archive-zip-update-case
(cond ((executable-find "zip") '("zip" "-q" "-k"))
@@ -288,8 +285,7 @@ Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zip)
+ (string :format "%v"))))
(declare-function msdos-long-file-names "msdos.c")
(defcustom archive-zip-case-fiddle (and (eq system-type 'ms-dos)
@@ -300,11 +296,14 @@ that uses caseless file names.
In addition, this flag forces members added/updated in the zip archive
to be truncated to DOS 8+3 file-name restrictions."
:type 'boolean
- :version "27.1"
- :group 'archive-zip)
+ :version "27.1")
;; ------------------------------
;; Zoo archive configuration
+(defgroup archive-zoo nil
+ "ZOO-specific options to archive."
+ :group 'archive)
+
(defcustom archive-zoo-extract
'("zoo" "xpq")
"Program and its options to run in order to extract a zoo file member.
@@ -313,8 +312,7 @@ be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zoo)
+ (string :format "%v"))))
(defcustom archive-zoo-expunge
'("zoo" "DqPP")
@@ -323,8 +321,7 @@ Archive and member names will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zoo)
+ (string :format "%v"))))
(defcustom archive-zoo-write-file-member
'("zoo" "a")
@@ -333,11 +330,14 @@ Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-zoo)
+ (string :format "%v"))))
;; ------------------------------
;; 7z archive configuration
+(defgroup archive-7z nil
+ "7Z-specific options to archive."
+ :group 'archive)
+
(defcustom archive-7z-extract
`(,(or archive-7z-program "7z") "x" "-so")
"Program and its options to run in order to extract a 7z file member.
@@ -347,8 +347,7 @@ be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-7z)
+ (string :format "%v"))))
(defcustom archive-7z-expunge
`(,(or archive-7z-program "7z") "d")
@@ -358,8 +357,7 @@ Archive and member names will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
- (string :format "%v")))
- :group 'archive-7z)
+ (string :format "%v"))))
(defcustom archive-7z-update
`(,(or archive-7z-program "7z") "u")
@@ -370,18 +368,35 @@ file. Archive and member name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
+ (string :format "%v"))))
+
+;; ------------------------------
+;; Squashfs archive configuration
+
+(defgroup archive-squashfs nil
+ "Squashfs-specific options to archive."
+ :group 'archive)
+
+(defcustom archive-squashfs-extract '("rdsquashfs" "-c")
+ "Program and its options to run in order to extract a squashsfs file member.
+Extraction should happen to standard output. Archive and member name will
+be added."
+ :type '(list (string :tag "Program")
+ (repeat :tag "Options"
+ :inline t
(string :format "%v")))
- :group 'archive-7z)
+ :version "28.1"
+ :group 'archive-squashfs)
;; -------------------------------------------------------------------------
;;; Section: Variables
(defvar archive-subtype nil "Symbol describing archive type.")
-(defvar archive-file-list-start nil "Position of first contents line.")
-(defvar archive-file-list-end nil "Position just after last contents line.")
-(defvar archive-proper-file-start nil "Position of real archive's start.")
+(defvar-local archive-file-list-start nil "Position of first contents line.")
+(defvar-local archive-file-list-end nil "Position just after last contents line.")
+(defvar-local archive-proper-file-start nil "Position of real archive's start.")
(defvar archive-read-only nil "Non-nil if the archive is read-only on disk.")
-(defvar archive-local-name nil "Name of local copy of remote archive.")
+(defvar-local archive-local-name nil "Name of local copy of remote archive.")
(defvar archive-mode-map
(let ((map (make-keymap)))
(set-keymap-parent map special-mode-map)
@@ -393,6 +408,7 @@ file. Archive and member name will be added."
(define-key map "e" 'archive-extract)
(define-key map "f" 'archive-extract)
(define-key map "\C-m" 'archive-extract)
+ (define-key map "C" 'archive-copy-file)
(define-key map "m" 'archive-mark)
(define-key map "n" 'archive-next-line)
(define-key map "\C-n" 'archive-next-line)
@@ -428,11 +444,13 @@ file. Archive and member name will be added."
(cons "Immediate" (make-sparse-keymap "Immediate")))
(define-key map [menu-bar immediate alternate]
'(menu-item "Alternate Display" archive-alternate-display
- :enable (boundp (archive-name "alternate-display"))
:help "Toggle alternate file info display"))
(define-key map [menu-bar immediate view]
'(menu-item "View This File" archive-view
:help "Display file at cursor in View Mode"))
+ (define-key map [menu-bar immediate view]
+ '(menu-item "Copy This File" archive-copy-file
+ :help "Copy file at cursor to another location"))
(define-key map [menu-bar immediate display]
'(menu-item "Display in Other Window" archive-display-other-window
:help "Display file at cursor in another window"))
@@ -483,36 +501,58 @@ file. Archive and member name will be added."
:help "Delete all flagged files from archive"))
map)
"Local keymap for archive mode listings.")
-(defvar archive-file-name-indent nil "Column where file names start.")
+(defvar-local archive-file-name-indent nil "Column where file names start.")
-(defvar archive-remote nil "Non-nil if the archive is outside file system.")
-(make-variable-buffer-local 'archive-remote)
+(defvar-local archive-remote nil "Non-nil if the archive is outside file system.")
(put 'archive-remote 'permanent-local t)
-(defvar archive-member-coding-system nil "Coding-system of archive member.")
-(make-variable-buffer-local 'archive-member-coding-system)
+(defvar-local archive-member-coding-system nil "Coding-system of archive member.")
-(defvar archive-alternate-display nil
+(defvar-local archive-alternate-display nil
"Non-nil when alternate information is shown.")
-(make-variable-buffer-local 'archive-alternate-display)
(put 'archive-alternate-display 'permanent-local t)
(defvar archive-superior-buffer nil "In archive members, points to archive.")
(put 'archive-superior-buffer 'permanent-local t)
-(defvar archive-subfile-mode nil "Non-nil in archive member buffers.")
-(make-variable-buffer-local 'archive-subfile-mode)
+(defvar-local archive-subfile-mode nil
+ "Non-nil in archive member buffers.
+Its value is an `archive--file-desc'.")
(put 'archive-subfile-mode 'permanent-local t)
-(defvar archive-file-name-coding-system nil)
-(make-variable-buffer-local 'archive-file-name-coding-system)
+(defvar-local archive-file-name-coding-system nil)
(put 'archive-file-name-coding-system 'permanent-local t)
-(defvar archive-files nil
- "Vector of file descriptors.
-Each descriptor is a vector of the form
- [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]")
-(make-variable-buffer-local 'archive-files)
+(cl-defstruct (archive--file-desc
+ (:constructor nil)
+ (:constructor archive--file-desc
+ ;; ext-file-name and int-file-name are usually `eq'
+ ;; except when int-file-name is the downcased
+ ;; ext-file-name.
+ (ext-file-name int-file-name mode size time
+ &key pos ratio uid gid)))
+ ext-file-name int-file-name
+ (mode nil :type integer)
+ (size nil :type integer)
+ (time nil :type string)
+ (ratio nil :type string)
+ uid gid
+ pos)
+
+;; Features in formats:
+;;
+;; ARC: size, date&time (date and time strings internally generated)
+;; LZH: size, date&time, mode, uid, gid (mode, date, time generated, ugid:int)
+;; ZIP: size, date&time, mode (mode, date, time generated)
+;; ZOO: size, date&time (date and time strings internally generated)
+;; AR : size, date&time, mode, user, group (internally generated)
+;; RAR: size, date&time, ratio (all as strings, using `lsar')
+;; 7Z : size, date&time (all as strings, using `7z' or `7za')
+;;
+;; LZH has alternate display (with UID/GID i.s.o MODE/DATE/TIME
+
+(defvar-local archive-files nil
+ "Vector of `archive--file-desc' objects.")
;; -------------------------------------------------------------------------
;;; Section: Support functions.
@@ -520,9 +560,9 @@ Each descriptor is a vector of the form
(defun arc-insert-unibyte (&rest args)
"Like insert but don't make unibyte string and eight-bit char multibyte."
(dolist (elt args)
- (if (integerp elt)
- (insert (if (< elt 128) elt (decode-char 'eight-bit elt)))
- (insert elt))))
+ (insert (if (and (integerp elt) (>= elt 128))
+ (decode-char 'eight-bit elt)
+ elt))))
(defsubst archive-name (suffix)
(intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
@@ -544,73 +584,19 @@ in which case a second argument, length LEN, should be supplied."
(aref str (- len i)))))
result))
-(defun archive-int-to-mode (mode)
- "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------."
- ;; FIXME: merge with tar-grind-file-mode.
- (string
- (if (zerop (logand 8192 mode))
- (if (zerop (logand 16384 mode)) ?- ?d)
- ?c) ; completeness
- (if (zerop (logand 256 mode)) ?- ?r)
- (if (zerop (logand 128 mode)) ?- ?w)
- (if (zerop (logand 64 mode))
- (if (zerop (logand 2048 mode)) ?- ?S)
- (if (zerop (logand 2048 mode)) ?x ?s))
- (if (zerop (logand 32 mode)) ?- ?r)
- (if (zerop (logand 16 mode)) ?- ?w)
- (if (zerop (logand 8 mode))
- (if (zerop (logand 1024 mode)) ?- ?S)
- (if (zerop (logand 1024 mode)) ?x ?s))
- (if (zerop (logand 4 mode)) ?- ?r)
- (if (zerop (logand 2 mode)) ?- ?w)
- (if (zerop (logand 1 mode)) ?- ?x)))
-
-(defun archive-calc-mode (oldmode newmode &optional error)
+(define-obsolete-function-alias 'archive-int-to-mode
+ 'file-modes-number-to-symbolic "28.1")
+
+(defun archive-calc-mode (oldmode newmode)
"From the integer OLDMODE and the string NEWMODE calculate a new file mode.
NEWMODE may be an octal number including a leading zero in which case it
will become the new mode.\n
NEWMODE may also be a relative specification like \"og-rwx\" in which case
-OLDMODE will be modified accordingly just like chmod(2) would have done.\n
-If optional third argument ERROR is non-nil an error will be signaled if
-the mode is invalid. If ERROR is nil then nil will be returned."
- (cond ((string-match "^0[0-7]*$" newmode)
- (let ((result 0)
- (len (length newmode))
- (i 1))
- (while (< i len)
- (setq result (+ (ash result 3) (aref newmode i) (- ?0))
- i (1+ i)))
- (logior (logand oldmode 65024) result)))
- ((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode)
- (let ((who 0)
- (result oldmode)
- (op (aref newmode (match-beginning 2)))
- (bits 0)
- (i (match-beginning 3)))
- (while (< i (match-end 3))
- (let ((rwx (aref newmode i)))
- (setq bits (logior bits (cond ((= rwx ?r) 292)
- ((= rwx ?w) 146)
- ((= rwx ?x) 73)
- ((= rwx ?s) 3072)
- ((= rwx ?t) 512)))
- i (1+ i))))
- (while (< who (match-end 1))
- (let* ((whoc (aref newmode who))
- (whomask (cond ((= whoc ?a) 4095)
- ((= whoc ?u) 1472)
- ((= whoc ?g) 2104)
- ((= whoc ?o) 7))))
- (if (= op ?=)
- (setq result (logand result (lognot whomask))))
- (if (= op ?-)
- (setq result (logand result (lognot (logand whomask bits))))
- (setq result (logior result (logand whomask bits)))))
- (setq who (1+ who)))
- result))
- (t
- (if error
- (error "Invalid mode specification: %s" newmode)))))
+OLDMODE will be modified accordingly just like chmod(2) would have done."
+ ;; FIXME: Use `file-modes-symbolic-to-number'!
+ (if (string-match "\\`0[0-7]*\\'" newmode)
+ (logior (logand oldmode #o177000) (string-to-number newmode 8))
+ (file-modes-symbolic-to-number newmode oldmode)))
(defun archive-dosdate (date)
"Stringify dos packed DATE record."
@@ -622,7 +608,8 @@ the mode is invalid. If ERROR is nil then nil will be returned."
(format "%2d-%s-%d"
day
(aref ["Jan" "Feb" "Mar" "Apr" "May" "Jun"
- "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] (1- month))
+ "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]
+ (1- month))
year))))
(defun archive-dostime (time)
@@ -658,10 +645,12 @@ Does not signal an error if optional argument NOERROR is non-nil."
(if (and (>= (point) archive-file-list-start)
(< no (length archive-files)))
(let ((item (aref archive-files no)))
- (if (vectorp item)
+ (if (and (archive--file-desc-p item)
+ (let ((mode (archive--file-desc-mode item)))
+ (zerop (logand 16384 mode))))
item
(if (not noerror)
- (error "Entry is not a regular member of the archive"))))
+ (user-error "Entry is not a regular member of the archive"))))
(if (not noerror)
(error "Line does not describe a member of the archive")))))
;; -------------------------------------------------------------------------
@@ -684,41 +673,34 @@ archive.
;; mode on and off. You can corrupt things that way.
(if (zerop (buffer-size))
;; At present we cannot create archives from scratch
- (funcall (or (default-value 'major-mode) 'fundamental-mode))
+ (funcall (or (default-value 'major-mode) #'fundamental-mode))
(if (and (not force) archive-files) nil
(kill-all-local-variables)
(let* ((type (archive-find-type))
(typename (capitalize (symbol-name type))))
- (make-local-variable 'archive-subtype)
- (setq archive-subtype type)
+ (setq-local archive-subtype type)
;; Buffer contains treated image of file before the file contents
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function 'archive-mode-revert)
- (auto-save-mode 0)
+ (add-function :around (local 'revert-buffer-function)
+ #'archive--mode-revert)
- (add-hook 'write-contents-functions 'archive-write-file nil t)
+ (add-hook 'write-contents-functions #'archive-write-file nil t)
- (make-local-variable 'require-final-newline)
- (setq require-final-newline nil)
- (make-local-variable 'local-enable-local-variables)
- (setq local-enable-local-variables nil)
+ (setq-local truncate-lines t)
+ (setq-local require-final-newline nil)
+ (setq-local local-enable-local-variables nil)
;; Prevent loss of data when saving the file.
- (make-local-variable 'file-precious-flag)
- (setq file-precious-flag t)
+ (setq-local file-precious-flag t)
- (make-local-variable 'archive-read-only)
;; Archives which are inside other archives and whose
;; names are invalid for this OS, can't be written.
- (setq archive-read-only
- (or (not (file-writable-p (buffer-file-name)))
- (and archive-subfile-mode
- (string-match file-name-invalid-regexp
- (aref archive-subfile-mode 0)))))
-
- ;; Should we use a local copy when accessing from outside Emacs?
- (make-local-variable 'archive-local-name)
+ (setq-local archive-read-only
+ (or (not (file-writable-p (buffer-file-name)))
+ (and archive-subfile-mode
+ (string-match file-name-invalid-regexp
+ (archive--file-desc-ext-file-name
+ archive-subfile-mode)))))
;; An archive can contain another archive whose name is invalid
;; on local filesystem. Treat such archives as remote.
@@ -728,16 +710,12 @@ archive.
(string-match file-name-invalid-regexp
(buffer-file-name)))))
- (setq major-mode 'archive-mode)
+ (setq major-mode #'archive-mode)
(setq mode-name (concat typename "-Archive"))
;; Run archive-foo-mode-hook and archive-mode-hook
(run-mode-hooks (archive-name "mode-hook") 'archive-mode-hook)
(use-local-map archive-mode-map))
- (make-local-variable 'archive-proper-file-start)
- (make-local-variable 'archive-file-list-start)
- (make-local-variable 'archive-file-list-end)
- (make-local-variable 'archive-file-name-indent)
(setq archive-file-name-coding-system
(or file-name-coding-system
default-file-name-coding-system
@@ -781,6 +759,7 @@ archive.
(re-search-forward "Rar!" (+ (point) 100000) t))
'rar-exe)
((looking-at "7z\274\257\047\034") '7z)
+ ((looking-at "hsqs") 'squashfs)
(t (error "Buffer format not recognized")))))
;; -------------------------------------------------------------------------
@@ -803,7 +782,7 @@ when parsing the archive."
(let ((create-lockfiles nil) ; avoid changing dir mtime by lock_file
(inhibit-read-only t))
(setq archive-proper-file-start (copy-marker (point-min) t))
- (set (make-local-variable 'change-major-mode-hook) 'archive-desummarize)
+ (add-hook 'change-major-mode-hook #'archive-desummarize nil t)
(or shut-up
(message "Parsing archive file..."))
(buffer-disable-undo (current-buffer))
@@ -825,27 +804,35 @@ when parsing the archive."
(goto-char archive-file-list-start)
(archive-next-line no)))
+(cl-defstruct (archive--file-summary
+ (:constructor nil)
+ (:constructor archive--file-summary (text name-start name-end)))
+ text name-start name-end)
+
(defun archive-summarize-files (files)
"Insert a description of a list of files annotated with proper mouse face."
(setq archive-file-list-start (point-marker))
- (setq archive-file-name-indent (if files (aref (car files) 1) 0))
+ ;; Here we assume that they all start at the same column.
+ (setq archive-file-name-indent
+ ;; FIXME: We assume chars=columns (no double-wide chars and such).
+ (if files (archive--file-summary-name-start (car files)) 0))
;; We don't want to do an insert for each element since that takes too
;; long when the archive -- which has to be moved in memory -- is large.
(insert
- (apply
- #'concat
- (mapcar
- (lambda (fil)
- ;; Using `concat' here copies the text also, so we can add
- ;; properties without problems.
- (let ((text (concat (aref fil 0) "\n")))
- (add-text-properties
- (aref fil 1) (aref fil 2)
- '(mouse-face highlight
- help-echo "mouse-2: extract this file into a buffer")
- text)
- text))
- files)))
+ (mapconcat
+ (lambda (fil)
+ ;; Using `concat' here copies the text also, so we can add
+ ;; properties without problems.
+ (let ((text (concat (archive--file-summary-text fil) "\n")))
+ (add-text-properties
+ (archive--file-summary-name-start fil)
+ (archive--file-summary-name-end fil)
+ '(mouse-face highlight
+ help-echo "mouse-2: extract this file into a buffer")
+ text)
+ text))
+ files
+ ""))
(setq archive-file-list-end (point-marker)))
(defun archive-alternate-display ()
@@ -854,7 +841,27 @@ To avoid very long lines archive mode does not show all information.
This function changes the set of information shown for each files."
(interactive)
(setq archive-alternate-display (not archive-alternate-display))
+ (setq-local archive-hidden-columns
+ (if archive-alternate-display
+ archive-alternate-hidden-columns
+ (eval (car (or (get 'archive-hidden-columns 'customized-value)
+ (get 'archive-hidden-columns 'standard-value)))
+ t)))
+ (archive-resummarize))
+
+(defun archive-hideshow-column (column)
+ "Toggle visibility of COLUMN."
+ (interactive
+ (list (intern
+ (completing-read "Toggle visibility of: "
+ '(Mode Ids Ratio Date&Time)
+ nil t))))
+ (setq-local archive-hidden-columns
+ (if (memq column archive-hidden-columns)
+ (remove column archive-hidden-columns)
+ (cons column archive-hidden-columns)))
(archive-resummarize))
+
;; -------------------------------------------------------------------------
;;; Section: Local archive copy handling
@@ -899,7 +906,8 @@ using `make-temp-file', and the generated name is returned."
;; "foo.zip:bar.zip", which is invalid on DOS/Windows.
;; So use the actual name if available.
(archive-name
- (or (and archive-subfile-mode (aref archive-subfile-mode 0))
+ (or (and archive-subfile-mode (archive--file-desc-ext-file-name
+ archive-subfile-mode))
archive)))
(setq archive-local-name
(archive-unique-fname archive-name archive-tmpdir))
@@ -918,6 +926,7 @@ using `make-temp-file', and the generated name is returned."
(lno (archive-get-lineno))
(inhibit-read-only t))
(if unchanged nil
+ ;; FIXME: Use archive-resummarize?
(setq archive-files nil)
(erase-buffer)
(insert-file-contents name)
@@ -968,7 +977,7 @@ using `make-temp-file', and the generated name is returned."
(delete-file tmpfile)))))
(defun archive-file-name-handler (op &rest args)
- (or (eq op 'file-exists-p)
+ (or (eq op #'file-exists-p)
(let ((file-name-handler-alist nil))
(apply op args))))
@@ -1002,14 +1011,83 @@ using `make-temp-file', and the generated name is returned."
(kill-local-variable 'buffer-file-coding-system)
(after-insert-file-set-coding (- (point-max) (point-min))))))
+(defun archive-goto-file (file)
+ "Go to FILE in the current buffer.
+FILE should be a relative file name. If FILE can't be found,
+return nil. Otherwise point is returned."
+ (let ((start (point))
+ found)
+ (goto-char (point-min))
+ (while (and (not found)
+ (not (eobp)))
+ (forward-line 1)
+ (when-let ((descr (archive-get-descr t)))
+ (when (equal (archive--file-desc-ext-file-name descr) file)
+ (setq found t))))
+ (if (not found)
+ (progn
+ (goto-char start)
+ nil)
+ (point))))
+
+(defun archive-next-file-displayer (file regexp n)
+ "Return a closure to display the next file after FILE that matches REGEXP."
+ (let ((short (replace-regexp-in-string "\\`.*:" "" file))
+ next)
+ (archive-goto-file short)
+ (while (and (not next)
+ ;; Stop if we reach the end/start of the buffer.
+ (if (> n 0)
+ (not (eobp))
+ (not (save-excursion
+ (beginning-of-line)
+ (bobp)))))
+ (archive-next-line n)
+ (when-let ((descr (archive-get-descr t)))
+ (let ((candidate (archive--file-desc-ext-file-name descr))
+ (buffer (current-buffer)))
+ (when (and candidate
+ (string-match-p regexp candidate))
+ (setq next (lambda ()
+ (kill-buffer (current-buffer))
+ (switch-to-buffer buffer)
+ (archive-extract)))))))
+ (unless next
+ ;; If we didn't find a next/prev file, then restore
+ ;; point.
+ (archive-goto-file short))
+ next))
+
+(defun archive-copy-file (file new-name)
+ "Copy FILE to a location specified by NEW-NAME.
+Interactively, FILE is the file at point, and the function prompts
+for NEW-NAME."
+ (interactive
+ (let ((name (archive--file-desc-ext-file-name (archive-get-descr))))
+ (list name
+ (read-file-name (format "Copy %s to: " name)))))
+ (when (file-directory-p new-name)
+ (setq new-name (expand-file-name file new-name)))
+ (when (and (file-exists-p new-name)
+ (not (yes-or-no-p (format "%s already exists; overwrite? "
+ new-name))))
+ (user-error "Not overwriting %s" new-name))
+ (let* ((descr (archive-get-descr))
+ (archive (buffer-file-name))
+ (extractor (archive-name "extract"))
+ (ename (archive--file-desc-ext-file-name descr)))
+ (with-temp-buffer
+ (archive--extract-file extractor archive ename)
+ (write-region (point-min) (point-max) new-name))))
+
(defun archive-extract (&optional other-window-p event)
"In archive mode, extract this entry of the archive into its own buffer."
(interactive (list nil last-input-event))
(if event (posn-set-point (event-end event)))
(let* ((view-p (eq other-window-p 'view))
(descr (archive-get-descr))
- (ename (aref descr 0))
- (iname (aref descr 1))
+ (ename (archive--file-desc-ext-file-name descr))
+ (iname (archive--file-desc-int-file-name descr))
(archive-buffer (current-buffer))
(arcdir default-directory)
(archive (buffer-file-name))
@@ -1038,32 +1116,12 @@ using `make-temp-file', and the generated name is returned."
(abbreviate-file-name buffer-file-name))
;; Set the default-directory to the dir of the superior buffer.
(setq default-directory arcdir)
- (make-local-variable 'archive-superior-buffer)
- (setq archive-superior-buffer archive-buffer)
+ (setq-local archive-superior-buffer archive-buffer)
(add-hook 'write-file-functions #'archive-write-file-member nil t)
(setq archive-subfile-mode descr)
(setq archive-file-name-coding-system file-name-coding)
(if (and
- (null
- (let (;; We may have to encode the file name argument for
- ;; external programs.
- (coding-system-for-write
- (and enable-multibyte-characters
- archive-file-name-coding-system))
- ;; We read an archive member by no-conversion at
- ;; first, then decode appropriately by calling
- ;; archive-set-buffer-as-visiting-file later.
- (coding-system-for-read 'no-conversion)
- ;; Avoid changing dir mtime by lock_file
- (create-lockfiles nil))
- (condition-case err
- (if (fboundp extractor)
- (funcall extractor archive ename)
- (archive-*-extract archive ename
- (symbol-value extractor)))
- (error
- (ding (message "%s" (error-message-string err)))
- nil))))
+ (null (archive--extract-file extractor archive ename))
just-created)
(progn
(set-buffer-modified-p nil)
@@ -1096,6 +1154,27 @@ using `make-temp-file', and the generated name is returned."
(other-window-p (switch-to-buffer-other-window buffer))
(t (switch-to-buffer buffer))))))
+(defun archive--extract-file (extractor archive ename)
+ (let (;; We may have to encode the file name argument for
+ ;; external programs.
+ (coding-system-for-write
+ (and enable-multibyte-characters
+ archive-file-name-coding-system))
+ ;; We read an archive member by no-conversion at
+ ;; first, then decode appropriately by calling
+ ;; archive-set-buffer-as-visiting-file later.
+ (coding-system-for-read 'no-conversion)
+ ;; Avoid changing dir mtime by lock_file
+ (create-lockfiles nil))
+ (condition-case err
+ (if (fboundp extractor)
+ (funcall extractor archive ename)
+ (archive-*-extract archive ename
+ (symbol-value extractor)))
+ (error
+ (ding (message "%s" (error-message-string err)))
+ nil))))
+
(defun archive-*-extract (archive name command)
(let* ((default-directory (file-name-as-directory archive-tmpdir))
(tmpfile (expand-file-name (file-name-nondirectory name)
@@ -1253,7 +1332,7 @@ using `make-temp-file', and the generated name is returned."
t)
(defun archive-*-write-file-member (archive descr command)
- (let* ((ename (aref descr 0))
+ (let* ((ename (archive--file-desc-ext-file-name descr))
(tmpfile (expand-file-name ename archive-tmpdir))
(top (directory-file-name (file-name-as-directory archive-tmpdir)))
(default-directory (file-name-as-directory top)))
@@ -1270,9 +1349,10 @@ using `make-temp-file', and the generated name is returned."
;; further processing clobbers it (we restore it in
;; archive-write-file-member, above).
(setq archive-member-coding-system last-coding-system-used)
- (if (aref descr 3)
+ (if (archive--file-desc-mode descr)
;; Set the file modes, but make sure we can read it.
- (set-file-modes tmpfile (logior ?\400 (aref descr 3))))
+ (set-file-modes tmpfile
+ (logior ?\400 (archive--file-desc-mode descr))))
(setq ename
(encode-coding-string ename archive-file-name-coding-system))
(let* ((coding-system-for-write 'no-conversion)
@@ -1376,7 +1456,7 @@ Use \\[archive-unmark-all-files] to remove all marks."
"Change the protection bits associated with all marked or this member.
The new protection bits can either be specified as an octal number or
as a relative change like \"g+rw\" as for chmod(2)."
- (interactive "sNew mode (octal or relative): ")
+ (interactive "sNew mode (octal or symbolic): ")
(if archive-read-only (error "Archive is read-only"))
(let ((func (archive-name "chmod-entry")))
(if (fboundp func)
@@ -1415,7 +1495,9 @@ as a relative change like \"g+rw\" as for chmod(2)."
(goto-char archive-file-list-start)
(while (< (point) archive-file-list-end)
(if (= (following-char) ?D)
- (setq files (cons (aref (archive-get-descr) 0) files)))
+ (setq files (cons (archive--file-desc-ext-file-name
+ (archive-get-descr))
+ files)))
(forward-line 1)))
(setq files (nreverse files))
(and files
@@ -1461,12 +1543,11 @@ as a relative change like \"g+rw\" as for chmod(2)."
(error "Renaming is not supported for this archive type"))))
;; Revert the buffer and recompute the dired-like listing.
-(defun archive-mode-revert (&optional _no-auto-save _no-confirm)
+(defun archive--mode-revert (orig-fun &rest args)
(let ((no (archive-get-lineno)))
(setq archive-files nil)
- (let ((revert-buffer-function nil)
- (coding-system-for-read 'no-conversion))
- (revert-buffer t t))
+ (let ((coding-system-for-read 'no-conversion))
+ (apply orig-fun t t (cddr args)))
(archive-mode)
(goto-char archive-file-list-start)
(archive-next-line no)))
@@ -1477,15 +1558,135 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(interactive)
(let ((inhibit-read-only t))
(undo)))
+
+(defun archive--fit (str len)
+ (let* ((spaces (- len (string-width str)))
+ (pre (/ spaces 2)))
+ (if (< spaces 1)
+ (substring str 0 len)
+ (concat (make-string pre ?\s) str (make-string (- spaces pre) ?\s)))))
+
+(defun archive--fit2 (str1 str2 len)
+ (let* ((spaces (- len (string-width str1) (string-width str2))))
+ (if (< spaces 1)
+ (substring (concat str1 str2) 0 len)
+ (concat str1 (make-string spaces ?\s) str2))))
+
+(defun archive--enabled-p (column)
+ (not (memq column archive-hidden-columns)))
+
+(defun archive--summarize-descs (descs)
+ (goto-char (point-min))
+ (if (null descs)
+ (progn (insert "M ... Filename\n")
+ (insert "- ----- ---------------\n")
+ (archive-summarize-files nil)
+ (insert "- ----- ---------------\n"))
+ (let* ((sample (car descs))
+ (maxsize 0)
+ (maxidlen 0)
+ (totalsize 0)
+ (times (archive--enabled-p 'Date&Time))
+ (ids (and (archive--enabled-p 'Ids)
+ (or (archive--file-desc-uid sample)
+ (archive--file-desc-gid sample))))
+ ;; For ratio, date/time, and mode, we presume that
+ ;; they're either present on all entries or on nonel, and that they
+ ;; take the same space on each of them.
+ (ratios (and (archive--enabled-p 'Ratio)
+ (archive--file-desc-ratio sample)))
+ (ratiolen (if ratios (string-width ratios)))
+ (timelen (length (archive--file-desc-time sample)))
+ (samplemode (and (archive--enabled-p 'Mode)
+ (archive--file-desc-mode sample)))
+ (modelen (length (if samplemode (file-modes-number-to-symbolic samplemode)))))
+ (dolist (desc descs)
+ (when ids
+ (let* ((uid (archive--file-desc-uid desc))
+ (gid (archive--file-desc-uid desc))
+ (len (cond
+ ((not uid) (string-width gid))
+ ((not gid) (string-width uid))
+ (t (+ (string-width uid) (string-width gid) 1)))))
+ (if (> len maxidlen) (setq maxidlen len))))
+ (let ((size (archive--file-desc-size desc)))
+ (cl-incf totalsize size)
+ (if (> size maxsize) (setq maxsize size))))
+ (let* ((sizelen (length (number-to-string maxsize)))
+ (dash
+ (concat
+ "- "
+ (if (> modelen 0) (concat (make-string modelen ?-) " "))
+ (if ids (concat (make-string maxidlen ?-) " "))
+ (make-string sizelen ?-) " "
+ (if ratios (concat (make-string (1+ ratiolen) ?-) " "))
+ " "
+ (if times (concat (make-string timelen ?-) " "))
+ "----------------\n"))
+ (startcol (+ 2
+ (if (> modelen 0) (+ 2 modelen) 0)
+ (if ids (+ maxidlen 2) 0)
+ sizelen 2
+ (if ratios (+ 2 ratiolen) 0)
+ (if times (+ timelen 2) 0))))
+ (insert
+ (concat "M "
+ (if (> modelen 0) (concat (archive--fit "Mode" modelen) " "))
+ (if ids (concat (archive--fit2 "Uid" "Gid" maxidlen) " "))
+ (archive--fit "Size" sizelen) " "
+ (if ratios (concat (archive--fit "Cmp" (1+ ratiolen)) " "))
+ " "
+ (if times (concat (archive--fit "Date&time" timelen) " "))
+ " Filename\n"))
+ (insert dash)
+ (archive-summarize-files
+ (mapcar (lambda (desc)
+ (let* ((size (number-to-string
+ (archive--file-desc-size desc)))
+ (text
+ (concat " "
+ (when (> modelen 0)
+ (concat (file-modes-number-to-symbolic
+ (archive--file-desc-mode desc))
+ " "))
+ (when ids
+ (concat (archive--fit2
+ (archive--file-desc-uid desc)
+ (archive--file-desc-gid desc)
+ maxidlen) " "))
+ (make-string (- sizelen (length size)) ?\s)
+ size
+ " "
+ (when ratios
+ (concat (archive--file-desc-ratio desc)
+ "% "))
+ " "
+ (when times
+ (concat (archive--file-desc-time desc)
+ " "))
+ (archive--file-desc-int-file-name desc))))
+ (archive--file-summary
+ text startcol (length text))))
+ descs))
+ (insert dash)
+ (insert (format (format "%%%dd %%s %%d files\n"
+ (+ 2
+ (if (> modelen 0) (+ 2 modelen) 0)
+ (if ids (+ maxidlen 2) 0)
+ sizelen))
+ totalsize
+ (make-string (+ (if times (+ 2 timelen) 0)
+ (if ratios (+ 2 ratiolen) 0) 1)
+ ?\s)
+ (length descs))))))
+ (apply #'vector descs))
+
;; -------------------------------------------------------------------------
;;; Section: Arc Archives
(defun archive-arc-summarize ()
(let ((p 1)
- (totalsize 0)
- (maxlen 8)
- files
- visual)
+ files)
(while (and (< (+ p 29) (point-max))
(= (get-byte p) ?\C-z)
(> (get-byte (1+ p)) 0))
@@ -1498,48 +1699,28 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(modtime (archive-l-e (+ p 21) 2))
(ucsize (archive-l-e (+ p 25) 4))
(fiddle (string= efnname (upcase efnname)))
- (ifnname (if fiddle (downcase efnname) efnname))
- (text (format " %8d %-11s %-8s %s"
- ucsize
- (archive-dosdate moddate)
- (archive-dostime modtime)
- ifnname)))
- (setq maxlen (max maxlen fnlen)
- totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length ifnname))
- (length text))
- visual)
- files (cons (vector efnname ifnname fiddle nil (1- p))
+ (ifnname (if fiddle (downcase efnname) efnname)))
+ (setq files (cons (archive--file-desc
+ efnname ifnname nil ucsize
+ (concat (archive-dosdate moddate)
+ " " (archive-dostime modtime))
+ :pos (1- p))
files)
p (+ p 29 csize))))
- (goto-char (point-min))
- (let ((dash (concat "- -------- ----------- -------- "
- (make-string maxlen ?-)
- "\n")))
- (insert "M Length Date Time File\n"
- dash)
- (archive-summarize-files (nreverse visual))
- (insert dash
- (format " %8d %d file%s"
- totalsize
- (length files)
- (if (= 1 (length files)) "" "s"))
- "\n"))
- (apply #'vector (nreverse files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-arc-rename-entry (newname descr)
(if (string-match "[:\\/]" newname)
(error "File names in arc files must not contain a directory component"))
(if (> (length newname) 12)
(error "File names in arc files are limited to 12 characters"))
- (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0"
- (length newname))))
+ (let ((name (concat newname (make-string (- 13 (length newname)) ?\0)))
(inhibit-read-only t))
(save-restriction
(save-excursion
(widen)
- (goto-char (+ archive-proper-file-start (aref descr 4) 2))
+ (goto-char (+ archive-proper-file-start 2
+ (archive--file-desc-pos descr)))
(delete-char 13)
(arc-insert-unibyte name)))))
;; -------------------------------------------------------------------------
@@ -1547,10 +1728,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(defun archive-lzh-summarize (&optional start)
(let ((p (or start 1)) ;; 1 for .lzh, something further on for .exe
- (totalsize 0)
- (maxlen 8)
- files
- visual)
+ files)
(while (progn (goto-char p) ;beginning of a base header.
(looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-"))
(let* ((hsize (get-byte p)) ;size of the base header (level 0 and 1)
@@ -1561,9 +1739,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2 header.)
(hdrlvl (get-byte (+ p 20))) ;header level
thsize ;total header size (base + extensions)
- fnlen efnname osid fiddle ifnname width p2
+ fnlen efnname osid fiddle ifnname p2
neh ;beginning of next extension header (level 1 and 2)
- mode modestr uid gid text dir prname
+ mode uid gid dir prname
gname uname modtime moddate)
(if (= hdrlvl 3) (error "can't handle lzh level 3 header type"))
(when (or (= hdrlvl 0) (= hdrlvl 1))
@@ -1576,26 +1754,26 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(setq neh (+ p2 3)) ;specific to level 1 header
(if (= hdrlvl 2)
(setq neh (+ p 24)))) ;specific to level 2 header
- (if neh ;if level 1 or 2 we expect extension headers to follow
+ (if neh ;if level 1 or 2 we expect extension headers to follow
(let* ((ehsize (archive-l-e neh 2)) ;size of the extension header
(etype (get-byte (+ neh 2)))) ;extension type
(while (not (= ehsize 0))
- (cond
- ((= etype 1) ;file name
+ (cond
+ ((= etype 1) ;file name
(let ((i (+ neh 3)))
(while (< i (+ neh ehsize))
(setq efnname (concat efnname (char-to-string (get-byte i))))
(setq i (1+ i)))))
- ((= etype 2) ;directory name
+ ((= etype 2) ;directory name
(let ((i (+ neh 3)))
(while (< i (+ neh ehsize))
- (setq dir (concat dir
- (if (= (get-byte i)
- 255)
- "/"
- (char-to-string
- (char-after i)))))
- (setq i (1+ i)))))
+ (setq dir (concat dir
+ (if (= (get-byte i)
+ 255)
+ "/"
+ (char-to-string
+ (char-after i)))))
+ (setq i (1+ i)))))
((= etype 80) ;Unix file permission
(setq mode (archive-l-e (+ neh 3) 2)))
((= etype 81) ;UNIX file group/user ID
@@ -1611,7 +1789,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(while (< i (+ neh ehsize))
(setq uname (concat uname (char-to-string (char-after i))))
(setq i (1+ i)))))
- )
+ )
(setq neh (+ neh ehsize))
(setq ehsize (archive-l-e neh 2))
(setq etype (get-byte (+ neh 2))))
@@ -1637,60 +1815,25 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
((= 0 osid) (string= efnname (upcase efnname)))))
(setq ifnname (if fiddle (downcase efnname) efnname))
(setq prname (if dir (concat dir ifnname) ifnname))
- (setq width (if prname (string-width prname) 0))
- (setq modestr (if mode (archive-int-to-mode mode) "??????????"))
(setq moddate (if (= hdrlvl 2)
(archive-unixdate time1 time2) ;level 2 header in UNIX format
(archive-dosdate time2))) ;level 0 and 1 header in DOS format
(setq modtime (if (= hdrlvl 2)
(archive-unixtime time1 time2)
(archive-dostime time1)))
- (setq text (if archive-alternate-display
- (format " %8d %5S %5S %s"
- ucsize
- (or uid "?")
- (or gid "?")
- ifnname)
- (format " %10s %8d %-11s %-8s %s"
- modestr
- ucsize
- moddate
- modtime
- prname)))
- (setq maxlen (max maxlen width)
- totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length prname))
- (length text))
- visual)
- files (cons (vector prname ifnname fiddle mode (1- p))
- files))
+ (push (archive--file-desc
+ prname ifnname mode ucsize
+ (concat moddate " " modtime)
+ :pos (1- p)
+ :uid (or uname (if uid (number-to-string uid)))
+ :gid (or gname (if gid (number-to-string gid))))
+ files)
(cond ((= hdrlvl 1)
(setq p (+ p hsize 2 csize)))
((or (= hdrlvl 2) (= hdrlvl 0))
(setq p (+ p thsize 2 csize))))
))
- (goto-char (point-min))
- (let ((dash (concat (if archive-alternate-display
- "- -------- ----- ----- "
- "- ---------- -------- ----------- -------- ")
- (make-string maxlen ?-)
- "\n"))
- (header (if archive-alternate-display
- "M Length Uid Gid File\n"
- "M Filemode Length Date Time File\n"))
- (sumline (if archive-alternate-display
- " %8.0f %d file%s"
- " %8.0f %d file%s")))
- (insert header dash)
- (archive-summarize-files (nreverse visual))
- (insert dash
- (format sumline
- totalsize
- (length files)
- (if (= 1 (length files)) "" "s"))
- "\n"))
- (apply #'vector (nreverse files))))
+ (archive--summarize-descs (nreverse files))))
(defconst archive-lzh-alternate-display t)
@@ -1709,7 +1852,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(save-restriction
(save-excursion
(widen)
- (let* ((p (+ archive-proper-file-start (aref descr 4)))
+ (let* ((p (+ archive-proper-file-start
+ (archive--file-desc-pos descr)))
(oldhsize (get-byte p))
(oldfnlen (get-byte (+ p 21)))
(newfnlen (length newname))
@@ -1729,7 +1873,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(save-restriction
(widen)
(dolist (fil files)
- (let* ((p (+ archive-proper-file-start (aref fil 4)))
+ (let* ((p (+ archive-proper-file-start (archive--file-desc-pos fil)))
(hsize (get-byte p))
(fnlen (get-byte (+ p 21)))
(p2 (+ p 22 fnlen))
@@ -1746,7 +1890,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(delete-char 1)
(arc-insert-unibyte (archive-lzh-resum (1+ p) hsize)))
(message "Member %s does not have %s field"
- (aref fil 1) errtxt)))))))
+ (archive--file-desc-int-file-name fil) errtxt)))))))
(defun archive-lzh-chown-entry (newuid files)
(archive-lzh-ogm newuid files "an uid" 10))
@@ -1756,8 +1900,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(defun archive-lzh-chmod-entry (newmode files)
(archive-lzh-ogm
- ;; This should work even though newmode will be dynamically accessed.
- (lambda (old) (archive-calc-mode old newmode t))
+ (lambda (old) (archive-calc-mode old newmode))
files "a unix-style mode" 8))
;; -------------------------------------------------------------------------
@@ -1794,11 +1937,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(goto-char (- (point-max) (- 22 18)))
(search-backward-regexp "[P]K\005\006")
(let ((p (archive-l-e (+ (point) 16) 4))
- (maxlen 8)
- (totalsize 0)
- files
- visual
- emacs-int-has-32bits)
+ files)
(when (or (= p #xffffffff) (= p -1))
;; If the offset of end-of-central-directory is 0xFFFFFFFF, this
;; is a Zip64 extended ZIP file format, and we need to glean the
@@ -1824,7 +1963,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(fnlen (archive-l-e (+ p 28) 2))
(exlen (archive-l-e (+ p 30) 2))
(fclen (archive-l-e (+ p 32) 2))
- (lheader (archive-l-e (+ p 42) 4))
+ ;; (lheader (archive-l-e (+ p 42) 4))
(efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen))))
(decode-coding-string
str archive-file-name-coding-system)))
@@ -1848,44 +1987,18 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(logand 1 (get-byte (+ p 38))))
?\222 0)))
(t nil)))
- (modestr (if mode (archive-int-to-mode mode) "??????????"))
(fiddle (and archive-zip-case-fiddle
- (not (not (memq creator '(0 2 4 5 9))))
+ (memq creator '(0 2 4 5 9))
(string= (upcase efnname) efnname)))
- (ifnname (if fiddle (downcase efnname) efnname))
- (width (string-width ifnname))
- (text (format " %10s %8d %-11s %-8s %s"
- modestr
- ucsize
- (archive-dosdate moddate)
- (archive-dostime modtime)
- ifnname)))
- (setq maxlen (max maxlen width)
- totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length ifnname))
- (length text))
- visual)
- files (cons (if isdir
- nil
- (vector efnname ifnname fiddle mode
- (list (1- p) lheader)))
- files)
+ (ifnname (if fiddle (downcase efnname) efnname)))
+ (setq files (cons (archive--file-desc
+ efnname ifnname mode ucsize
+ (concat (archive-dosdate moddate)
+ " " (archive-dostime modtime))
+ :pos (1- p))
+ files)
p (+ p 46 fnlen exlen fclen))))
- (goto-char (point-min))
- (let ((dash (concat "- ---------- -------- ----------- -------- "
- (make-string maxlen ?-)
- "\n")))
- (insert "M Filemode Length Date Time File\n"
- dash)
- (archive-summarize-files (nreverse visual))
- (insert dash
- (format " %8d %d file%s"
- totalsize
- (length files)
- (if (= 1 (length files)) "" "s"))
- "\n"))
- (apply #'vector (nreverse files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-zip-extract (archive name)
(cond
@@ -1910,21 +2023,27 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
name)
archive-zip-extract))))
+(defun archive--file-desc-case-fiddled (fd)
+ (not (eq (archive--file-desc-int-file-name fd)
+ (archive--file-desc-ext-file-name fd))))
+
(defun archive-zip-write-file-member (archive descr)
(archive-*-write-file-member
archive
descr
- (if (aref descr 2) archive-zip-update-case archive-zip-update)))
+ (if (archive--file-desc-case-fiddled descr)
+ archive-zip-update-case archive-zip-update)))
(defun archive-zip-chmod-entry (newmode files)
(save-restriction
(save-excursion
(widen)
(dolist (fil files)
- (let* ((p (+ archive-proper-file-start (car (aref fil 4))))
+ (let* ((p (+ archive-proper-file-start
+ (archive--file-desc-pos fil)))
(creator (get-byte (+ p 5)))
- (oldmode (aref fil 3))
- (newval (archive-calc-mode oldmode newmode t))
+ (oldmode (archive--file-desc-mode fil))
+ (newval (archive-calc-mode oldmode newmode))
(inhibit-read-only t))
(cond ((memq creator '(2 3)) ; Unix
(goto-char (+ p 40))
@@ -1943,10 +2062,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(defun archive-zoo-summarize ()
(let ((p (1+ (archive-l-e 25 4)))
- (maxlen 8)
- (totalsize 0)
- files
- visual)
+ files)
(while (and (string= "\334\247\304\375" (buffer-substring p (+ p 4)))
(> (archive-l-e (+ p 6) 4) 0))
(let* ((next (1+ (archive-l-e (+ p 6) 4)))
@@ -1973,36 +2089,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(decode-coding-string
str archive-file-name-coding-system)))
(fiddle (and (= lfnlen 0) (string= efnname (upcase efnname))))
- (ifnname (if fiddle (downcase efnname) efnname))
- (width (string-width ifnname))
- (text (format " %8d %-11s %-8s %s"
- ucsize
- (archive-dosdate moddate)
- (archive-dostime modtime)
- ifnname)))
- (setq maxlen (max maxlen width)
- totalsize (+ totalsize ucsize)
- visual (cons (vector text
- (- (length text) (length ifnname))
- (length text))
- visual)
- files (cons (vector efnname ifnname fiddle nil (1- p))
+ (ifnname (if fiddle (downcase efnname) efnname)))
+ (setq files (cons (archive--file-desc
+ efnname ifnname nil ucsize
+ (concat (archive-dosdate moddate)
+ " " (archive-dostime modtime)))
files)
p next)))
- (goto-char (point-min))
- (let ((dash (concat "- -------- ----------- -------- "
- (make-string maxlen ?-)
- "\n")))
- (insert "M Length Date Time File\n"
- dash)
- (archive-summarize-files (nreverse visual))
- (insert dash
- (format " %8d %d file%s"
- totalsize
- (length files)
- (if (= 1 (length files)) "" "s"))
- "\n"))
- (apply #'vector (nreverse files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-zoo-extract (archive name)
(archive-extract-by-stdout archive name archive-zoo-extract))
@@ -2014,17 +2108,16 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
;; File is used internally for `archive-rar-exe-summarize'.
(unless file (setq file buffer-file-name))
(let* ((copy (file-local-copy file))
- (maxname 10)
- (maxsize 5)
(files ()))
(with-temp-buffer
- (call-process "lsar" nil t nil "-l" (or file copy))
- (if copy (delete-file copy))
+ (unwind-protect
+ (call-process "lsar" nil t nil "-l" (or file copy))
+ (if copy (delete-file copy)))
(goto-char (point-min))
- (re-search-forward "^\\(\s+=+\s*\\)+\n")
+ (re-search-forward "^\\(?:\s+=+\\)+\s*\n")
(while (looking-at (concat "^\s+[0-9.]+\s+D?-+\s+" ; Flags
"\\([0-9-]+\\)\s+" ; Size
- "\\([-0-9.%]+\\)\s+" ; Ratio
+ "\\([-0-9.]+\\)%?\s+" ; Ratio
"\\([0-9a-zA-Z]+\\)\s+" ; Mode
"\\([0-9-]+\\)\s+" ; Date
"\\([0-9:]+\\)\s+" ; Time
@@ -2033,36 +2126,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(goto-char (match-end 0))
(let ((name (match-string 6))
(size (match-string 1)))
- (if (> (length name) maxname) (setq maxname (length name)))
- (if (> (length size) maxsize) (setq maxsize (length size)))
- (push (vector name name nil nil
- ;; Size, Ratio.
- size (match-string 2)
- ;; Date, Time.
- (match-string 4) (match-string 5))
+ (push (archive--file-desc name name nil
+ ;; Size
+ (string-to-number size)
+ ;; Date&Time.
+ (concat (match-string 4) " " (match-string 5))
+ :ratio (match-string 2))
files))))
- (setq files (nreverse files))
- (goto-char (point-min))
- (let* ((format (format " %%s %%s %%%ds %%5s %%s" maxsize))
- (sep (format format "----------" "-----" (make-string maxsize ?-)
- "-----" ""))
- (column (length sep)))
- (insert (format format " Date " "Time " "Size" "Ratio" "Filename") "\n")
- (insert sep (make-string maxname ?-) "\n")
- (archive-summarize-files (mapcar (lambda (desc)
- (let ((text
- (format format
- (aref desc 6)
- (aref desc 7)
- (aref desc 4)
- (aref desc 5)
- (aref desc 1))))
- (vector text
- column
- (length text))))
- files))
- (insert sep (make-string maxname ?-) "\n")
- (apply #'vector files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-rar-extract (archive name)
;; unrar-free seems to have no way to extract to stdout or even to a file.
@@ -2109,9 +2180,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
;;; Section: 7z Archives
(defun archive-7z-summarize ()
- (let ((maxname 10)
- (maxsize 5)
- (file buffer-file-name)
+ (let ((file buffer-file-name)
(files ()))
(with-temp-buffer
(call-process archive-7z-program nil t nil "l" "-slt" file)
@@ -2128,29 +2197,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(time (save-excursion
(and (re-search-forward "^Modified = \\(.*\\)\n")
(match-string 1)))))
- (if (> (length name) maxname) (setq maxname (length name)))
- (if (> (length size) maxsize) (setq maxsize (length size)))
- (push (vector name name nil nil time nil nil size)
+ (push (archive--file-desc name name nil (string-to-number size) time)
files))))
- (setq files (nreverse files))
- (goto-char (point-min))
- (let* ((format (format " %%%ds %%s %%s" maxsize))
- (sep (format format (make-string maxsize ?-) "-------------------" ""))
- (column (length sep)))
- (insert (format format "Size " "Date Time " " Filename") "\n")
- (insert sep (make-string maxname ?-) "\n")
- (archive-summarize-files (mapcar (lambda (desc)
- (let ((text
- (format format
- (aref desc 7)
- (aref desc 4)
- (aref desc 1))))
- (vector text
- column
- (length text))))
- files))
- (insert sep (make-string maxname ?-) "\n")
- (apply #'vector files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-7z-extract (archive name)
;; 7z doesn't provide a `quiet' option to suppress non-essential
@@ -2177,79 +2226,43 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(defconst archive-ar-file-header-re
"\\(.\\{16\\}\\)\\([ 0-9]\\{12\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-9]\\{6\\}\\)\\([ 0-7]\\{8\\}\\)\\([ 0-9]\\{10\\}\\)`\n")
+(defun archive-ar--name (name)
+ "Return the external name represented by the entry NAME.
+NAME is expected to be the 16-bytes part of an ar record."
+ (cond ((equal name "// ")
+ (propertize ".<ExtNamesTable>." 'face 'italic))
+ ((equal name "/ ")
+ (propertize ".<LookupTable>." 'face 'italic))
+ ((string-match "/? *\\'" name)
+ ;; FIXME: Decode? Add support for longer names?
+ (substring name 0 (match-beginning 0)))))
+
(defun archive-ar-summarize ()
;; File is used internally for `archive-rar-exe-summarize'.
- (let* ((maxname 10)
- (maxtime 16)
- (maxuser 5)
- (maxgroup 5)
- (maxmode 8)
- (maxsize 5)
- (files ()))
+ (let* ((files ()))
(goto-char (point-min))
(search-forward "!<arch>\n")
(while (looking-at archive-ar-file-header-re)
- (let ((name (match-string 1))
- extname
- (time (string-to-number (match-string 2)))
- (user (match-string 3))
- (group (match-string 4))
- (mode (string-to-number (match-string 5) 8))
- (size (string-to-number (match-string 6))))
+ (let* ((name (match-string 1))
+ extname
+ (time (string-to-number (match-string 2)))
+ (user (match-string 3))
+ (group (match-string 4))
+ (mode (string-to-number (match-string 5) 8))
+ (sizestr (match-string 6))
+ (size (string-to-number sizestr)))
;; Move to the beginning of the data.
(goto-char (match-end 0))
(setq time (format-time-string "%Y-%m-%d %H:%M" time))
- (setq extname
- (cond ((equal name "// ")
- (propertize ".<ExtNamesTable>." 'face 'italic))
- ((equal name "/ ")
- (propertize ".<LookupTable>." 'face 'italic))
- ((string-match "/? *\\'" name)
- (substring name 0 (match-beginning 0)))))
+ (setq extname (archive-ar--name name))
(setq user (substring user 0 (string-match " +\\'" user)))
(setq group (substring group 0 (string-match " +\\'" group)))
- (setq mode (tar-grind-file-mode mode))
;; Move to the end of the data.
(forward-char size) (if (eq ?\n (char-after)) (forward-char 1))
- (setq size (number-to-string size))
- (if (> (length name) maxname) (setq maxname (length name)))
- (if (> (length time) maxtime) (setq maxtime (length time)))
- (if (> (length user) maxuser) (setq maxuser (length user)))
- (if (> (length group) maxgroup) (setq maxgroup (length group)))
- (if (> (length mode) maxmode) (setq maxmode (length mode)))
- (if (> (length size) maxsize) (setq maxsize (length size)))
- (push (vector name extname nil mode
- time user group size)
+ (push (archive--file-desc extname extname mode size time
+ :uid user :gid group)
files)))
- (setq files (nreverse files))
- (goto-char (point-min))
- (let* ((format (format "%%%ds %%%ds/%%-%ds %%%ds %%%ds %%s"
- maxmode maxuser maxgroup maxsize maxtime))
- (sep (format format (make-string maxmode ?-)
- (make-string maxuser ?-)
- (make-string maxgroup ?-)
- (make-string maxsize ?-)
- (make-string maxtime ?-) ""))
- (column (length sep)))
- (insert (format format " Mode " "User" "Group" " Size "
- " Date " "Filename")
- "\n")
- (insert sep (make-string maxname ?-) "\n")
- (archive-summarize-files (mapcar (lambda (desc)
- (let ((text
- (format format
- (aref desc 3)
- (aref desc 5)
- (aref desc 6)
- (aref desc 7)
- (aref desc 4)
- (aref desc 1))))
- (vector text
- column
- (length text))))
- files))
- (insert sep (make-string maxname ?-) "\n")
- (apply #'vector files))))
+ (archive--summarize-descs (nreverse files))))
(defun archive-ar-extract (archive name)
(let ((destbuf (current-buffer))
@@ -2266,10 +2279,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(let ((this (match-string 1)))
(setq size (string-to-number (match-string 6)))
(goto-char (match-end 0))
- (if (equal name this)
+ (if (equal name (archive-ar--name this))
(setq from (point))
;; Move to the end of the data.
- (forward-char size) (if (eq ?\n (char-after)) (forward-char 1)))))
+ (forward-char size)
+ (if (eq ?\n (char-after)) (forward-char 1)))))
(when from
(set-buffer-multibyte nil)
(with-current-buffer destbuf
@@ -2279,6 +2293,92 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
;; Inform the caller that the call succeeded.
t))))))
+(defun archive-ar-write-file-member (archive descr)
+ (archive-*-write-file-member
+ archive
+ descr
+ '("ar" "r")))
+
+;; -------------------------------------------------------------------------
+;;; Section Squashfs archives.
+
+(defun archive-squashfs-summarize (&optional file)
+ (unless file
+ (setq file buffer-file-name))
+ (let ((copy (file-local-copy file))
+ (files ()))
+ (with-temp-buffer
+ (call-process "unsquashfs" nil t nil "-ll" (or file copy))
+ (when copy
+ (delete-file copy))
+ (goto-char (point-min))
+ (search-forward-regexp "[drwxl\\-]\\{10\\}")
+ (beginning-of-line)
+ (while (looking-at (concat
+ "^\\(.[rwx\\-]\\{9\\}\\) " ;Mode
+ "\\(.+\\)/\\(.+\\) " ;user/group
+ "\\(.+\\) " ;size
+ "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\) " ;date
+ "\\([0-9]\\{2\\}:[0-9]\\{2\\}\\) " ;time
+ "\\(.+\\)\n")) ;Filename
+ (let* ((name (match-string 7))
+ (flags (match-string 1))
+ (uid (match-string 2))
+ (gid (match-string 3))
+ (size (string-to-number (match-string 4)))
+ (date (match-string 5))
+ (time (match-string 6))
+ (date-time)
+ (mode))
+ ;; Only list directory and regular files
+ (when (or (eq (aref flags 0) ?d)
+ (eq (aref flags 0) ?-))
+ (when (equal name "squashfs-root")
+ (setf name "/"))
+ ;; Remove 'squashfs-root/' from filenames.
+ (setq name (string-replace "squashfs-root/" "" name))
+ (setq date-time (concat date " " time))
+ (setq mode (logior
+ (cond
+ ((eq (aref flags 0) ?d) #o40000)
+ (t 0))
+ ;; Convert symbolic to octal representation.
+ (file-modes-symbolic-to-number
+ (concat
+ "u=" (string-replace "-" "" (substring flags 1 4))
+ ",g=" (string-replace "-" "" (substring flags 4 7))
+ ",o=" (string-replace "-" ""
+ (substring flags 7 10))))))
+ (push (archive--file-desc name name mode size
+ date-time :uid uid :gid gid)
+ files)))
+ (goto-char (match-end 0))))
+ (archive--summarize-descs (nreverse files))))
+
+(defun archive-squashfs-extract-by-stdout (archive name command
+ &optional stderr-test)
+ (let ((stderr-file (make-temp-file "arc-stderr")))
+ (unwind-protect
+ (prog1
+ (apply #'call-process
+ (car command)
+ nil
+ (if stderr-file (list t stderr-file) t)
+ nil
+ (append (cdr command) (list name archive)))
+ (with-temp-buffer
+ (insert-file-contents stderr-file)
+ (goto-char (point-min))
+ (when (if (stringp stderr-test)
+ (not (re-search-forward stderr-test nil t))
+ (> (buffer-size) 0))
+ (message "%s" (buffer-string)))))
+ (if (file-exists-p stderr-file)
+ (delete-file stderr-file)))))
+
+(defun archive-squashfs-extract (archive name)
+ (archive-squashfs-extract-by-stdout archive name archive-squashfs-extract))
+
;; -------------------------------------------------------------------------
;; This line was a mistake; it is kept now for compatibility.
;; rms 15 Oct 98
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 7a0e09b9e8e..50795ce7946 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -2073,7 +2073,9 @@ entries for git.gnus.org:
(setcar
(cdr secret)
(let ((v (car (cdr secret))))
- (lambda () v))))
+ (if (functionp v)
+ (lambda () (funcall v plist))
+ (lambda () v)))))
plist))
items))
;; ensure each item has each key in `returned-keys'
diff --git a/lisp/autoarg.el b/lisp/autoarg.el
index c0307aa92b1..d41527775f4 100644
--- a/lisp/autoarg.el
+++ b/lisp/autoarg.el
@@ -1,4 +1,4 @@
-;;; autoarg.el --- make digit keys supply prefix args
+;;; autoarg.el --- make digit keys supply prefix args -*- lexical-binding: t -*-
;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
@@ -59,9 +59,8 @@
;; (define-key autoarg-mode-map [?\r] 'autoarg-terminate)
(defvar autoarg-kp-digits
- (let (alist)
- (dotimes (i 10 alist)
- (push (cons (intern (format "kp-%d" i)) i) alist))))
+ (mapcar (lambda (i) (cons (intern (format "kp-%d" i)) i))
+ (reverse (number-sequence 0 9))))
(defun autoarg-kp-digit-argument (arg)
"Part of the numeric argument for the next command, like `digit-argument'."
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 6d3802816de..9bb485f55dc 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -315,8 +315,7 @@ The document was typeset with
@printindex cp
@bye
-
-@c " (file-name-nondirectory (buffer-file-name)) " ends here\n"))
+"))
"A list specifying text to insert by default into a new file.
Elements look like (CONDITION . ACTION) or ((CONDITION . DESCRIPTION) . ACTION).
CONDITION may be a regexp that must match the new file's name, or it may be
@@ -396,7 +395,7 @@ Matches the visited file name against the elements of `auto-insert-alist'."
;; which might ask the user for something
(switch-to-buffer (current-buffer))
(if (and (consp action)
- (not (eq (car action) 'lambda)))
+ (not (functionp action)))
(skeleton-insert action)
(funcall action)))))
(if (vectorp action)
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 011febfe728..046ea2b5d6a 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -242,6 +242,8 @@ For more information, see Info node `(emacs)Autorevert'."
:tag "Load Hook"
:group 'auto-revert
:type 'hook)
+(make-obsolete-variable 'auto-revert-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom auto-revert-check-vc-info nil
"If non-nil Auto-Revert Mode reliably updates version control info.
@@ -869,6 +871,62 @@ This is an internal function used by Auto-Revert Mode."
(restore-buffer-modified-p modified)))
(set-visited-file-modtime))
+(defun auto-revert--buffer-candidates ()
+ "Return a prioritized list of buffers to maybe auto-revert.
+The differences between this return value and the reference
+variable `auto-revert-buffer-list' include: 1) this has more
+entries when in global-auto-revert-mode; 2) this prioritizes
+buffers not reverted last time due to user interruption. "
+ (let ((bufs (delq nil
+ ;; Buffers with remote contents shall be reverted only
+ ;; if the connection is established already.
+ (mapcar
+ (lambda (buf)
+ (and (buffer-live-p buf)
+ (with-current-buffer buf
+ (and
+ (or (not (file-remote-p default-directory))
+ (file-remote-p default-directory nil t))
+ buf))))
+ (auto-revert--polled-buffers))))
+ remaining new)
+ ;; Partition `bufs' into two halves depending on whether or not
+ ;; the buffers are in `auto-revert-remaining-buffers'. The two
+ ;; halves are then re-joined with the "remaining" buffers at the
+ ;; head of the list.
+ (dolist (buf auto-revert-remaining-buffers)
+ (when (memq buf bufs)
+ (push buf remaining)))
+ (dolist (buf bufs)
+ (unless (memq buf remaining)
+ (push buf new)))
+ (nreverse (nconc new remaining))))
+
+(defun auto-revert-buffer (buf)
+ "Revert a single buffer.
+
+This is performed as specified by Auto-Revert and Global
+Auto-Revert Modes."
+ (if (not (buffer-live-p buf))
+ (auto-revert-remove-current-buffer buf)
+ (with-current-buffer buf
+ ;; Test if someone has turned off Auto-Revert Mode
+ ;; in a non-standard way, for example by changing
+ ;; major mode.
+ (when (and (not auto-revert-mode)
+ (not auto-revert-tail-mode))
+ (auto-revert-remove-current-buffer))
+ (when (auto-revert-active-p)
+ ;; Enable file notification.
+ ;; Don't bother creating a notifier for non-file buffers
+ ;; unless it explicitly indicates that this works.
+ (when (and auto-revert-use-notify
+ (not auto-revert-notify-watch-descriptor)
+ (or buffer-file-name
+ buffer-auto-revert-by-notification))
+ (auto-revert-notify-add-watch))
+ (auto-revert-handler)))))
+
(defun auto-revert-buffers ()
"Revert buffers as specified by Auto-Revert and Global Auto-Revert Mode.
@@ -892,67 +950,19 @@ are checked first the next time this function is called.
This function is also responsible for removing buffers no longer in
Auto-Revert Mode from `auto-revert-buffer-list', and for canceling
the timer when no buffers need to be checked."
-
(save-match-data
- (let ((bufs (auto-revert--polled-buffers))
- remaining new)
- ;; Buffers with remote contents shall be reverted only if the
- ;; connection is established already.
- (setq bufs (delq nil
- (mapcar
- (lambda (buf)
- (and (buffer-live-p buf)
- (with-current-buffer buf
- (and
- (or (not (file-remote-p default-directory))
- (file-remote-p default-directory nil t))
- buf))))
- bufs)))
- ;; Partition `bufs' into two halves depending on whether or not
- ;; the buffers are in `auto-revert-remaining-buffers'. The two
- ;; halves are then re-joined with the "remaining" buffers at the
- ;; head of the list.
- (dolist (buf auto-revert-remaining-buffers)
- (if (memq buf bufs)
- (push buf remaining)))
- (dolist (buf bufs)
- (if (not (memq buf remaining))
- (push buf new)))
- (setq bufs (nreverse (nconc new remaining)))
+ (let ((bufs (auto-revert--buffer-candidates)))
(while (and bufs
(not (and auto-revert-stop-on-user-input
(input-pending-p))))
- (let ((buf (car bufs)))
- (if (not (buffer-live-p buf))
- ;; Remove dead buffer from `auto-revert-buffer-list'.
- (auto-revert-remove-current-buffer buf)
- (with-current-buffer buf
- ;; Test if someone has turned off Auto-Revert Mode
- ;; in a non-standard way, for example by changing
- ;; major mode.
- (if (and (not auto-revert-mode)
- (not auto-revert-tail-mode)
- (memq buf auto-revert-buffer-list))
- (auto-revert-remove-current-buffer))
- (when (auto-revert-active-p)
- ;; Enable file notification.
- ;; Don't bother creating a notifier for non-file buffers
- ;; unless it explicitly indicates that this works.
- (when (and auto-revert-use-notify
- (not auto-revert-notify-watch-descriptor)
- (or buffer-file-name
- buffer-auto-revert-by-notification))
- (auto-revert-notify-add-watch))
- (auto-revert-handler)))))
- (setq bufs (cdr bufs)))
+ (auto-revert-buffer (pop bufs)))
(setq auto-revert-remaining-buffers bufs)
;; Check if we should cancel the timer.
(unless (auto-revert--need-polling-p)
- (if (timerp auto-revert-timer)
- (cancel-timer auto-revert-timer))
+ (when (timerp auto-revert-timer)
+ (cancel-timer auto-revert-timer))
(setq auto-revert-timer nil)))))
-
;; The end:
(provide 'autorevert)
diff --git a/lisp/battery.el b/lisp/battery.el
index 1d3390070c3..e568ab52460 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -1,8 +1,9 @@
-;;; battery.el --- display battery status information
+;;; battery.el --- display battery status information -*- lexical-binding:t -*-
;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
;; Author: Ralph Schleicher <rs@ralph-schleicher.de>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: hardware
;; This file is part of GNU Emacs.
@@ -22,15 +23,19 @@
;;; Commentary:
-;; There is at present support for GNU/Linux, macOS and Windows. This
-;; library supports both the `/proc/apm' file format of Linux version
-;; 1.3.58 or newer and the `/proc/acpi/' directory structure of Linux
-;; 2.4.20 and 2.6. Darwin (macOS) is supported by using the `pmset'
-;; program. Windows is supported by the GetSystemPowerStatus API call.
+;; There is at present support for GNU/Linux, BSD, macOS, and Windows.
+;; This library supports:
+;; - UPower (https://upower.freedesktop.org) via D-Bus API.
+;; - The `/sys/class/power_supply/' files of Linux >= 2.6.39.
+;; - The `/proc/acpi/' directory structure of Linux 2.4.20 and 2.6.
+;; - The `/proc/apm' file format of Linux version 1.3.58 or newer.
+;; - BSD by using the `apm' program.
+;; - Darwin (macOS) by using the `pmset' program.
+;; - Windows via the GetSystemPowerStatus API call.
;;; Code:
-(require 'timer)
+(require 'dbus)
(eval-when-compile (require 'cl-lib))
(defgroup battery nil
@@ -38,41 +43,75 @@
:prefix "battery-"
:group 'hardware)
-(defcustom battery-upower-device "battery_BAT1"
- "Upower battery device name."
- :version "26.1"
- :type 'string
- :group 'battery)
+(defcustom battery-upower-device nil
+ "Preferred UPower device name(s).
+When `battery-status-function' is set to `battery-upower', this
+user option specifies which power sources to query for status
+information and merge into a single report.
+
+When nil (the default), `battery-upower' queries all present
+battery and line power devices as determined by the UPower
+EnumerateDevices method. A string or a nonempty list of strings
+names particular devices to query instead. UPower battery and
+line power device names typically follow the patterns
+\"battery_BATN\" and \"line_power_ACN\", respectively, with N
+starting at 0 when present. Device names should not include the
+leading D-Bus path \"/org/freedesktop/UPower/devices/\"."
+ :version "28.1"
+ :type '(choice (const :tag "Autodetect all devices" nil)
+ (string :tag "Device")
+ (repeat :tag "Devices" string)))
+
+(defcustom battery-upower-subscribe t
+ "Whether to subscribe to UPower device change signals.
+When nil, battery status information is polled every
+`battery-update-interval' seconds. When non-nil (the default),
+the battery status is also updated whenever a power source is
+added or removed, or when the system starts or stops running on
+battery power.
+
+This only takes effect when `battery-status-function' is set to
+`battery-upower' before enabling `display-battery-mode'."
+ :version "28.1"
+ :type 'boolean)
+
+(defconst battery-upower-service "org.freedesktop.UPower"
+ "Well-known name of the UPower D-Bus service.
+See URL `https://upower.freedesktop.org/docs/ref-dbus.html'.")
+
+(defun battery--files (dir)
+ "Return a list of absolute file names in DIR or nil on error.
+Value does not include \".\" or \"..\"."
+ (ignore-errors (directory-files dir t directory-files-no-dot-files-regexp)))
(defun battery--find-linux-sysfs-batteries ()
- (let ((dirs nil))
- (dolist (file (directory-files "/sys/class/power_supply/" t))
- (when (and (or (file-directory-p file)
- (file-symlink-p file))
- (file-exists-p (expand-file-name "capacity" file)))
- (push file dirs)))
+ "Return a list of all sysfs battery directories."
+ (let (dirs)
+ (dolist (dir (battery--files "/sys/class/power_supply/"))
+ (when (file-exists-p (expand-file-name "capacity" dir))
+ (push dir dirs)))
(nreverse dirs)))
(defcustom battery-status-function
- (cond ((and (eq system-type 'gnu/linux)
- (file-readable-p "/proc/apm"))
- #'battery-linux-proc-apm)
+ (cond ((member battery-upower-service (dbus-list-activatable-names))
+ #'battery-upower)
+ ((and (eq system-type 'gnu/linux)
+ (battery--find-linux-sysfs-batteries))
+ #'battery-linux-sysfs)
((and (eq system-type 'gnu/linux)
(file-directory-p "/proc/acpi/battery"))
#'battery-linux-proc-acpi)
((and (eq system-type 'gnu/linux)
- (file-directory-p "/sys/class/power_supply/")
- (battery--find-linux-sysfs-batteries))
- #'battery-linux-sysfs)
+ (file-readable-p "/proc/apm"))
+ #'battery-linux-proc-apm)
((and (eq system-type 'berkeley-unix)
(file-executable-p "/usr/sbin/apm"))
#'battery-bsd-apm)
((and (eq system-type 'darwin)
- (condition-case nil
- (with-temp-buffer
- (and (eq (call-process "pmset" nil t nil "-g" "ps") 0)
- (> (buffer-size) 0)))
- (error nil)))
+ (ignore-errors
+ (with-temp-buffer
+ (and (eq (call-process "pmset" nil t nil "-g" "ps") 0)
+ (not (bobp))))))
#'battery-pmset)
((fboundp 'w32-battery-status)
#'w32-battery-status))
@@ -84,8 +123,8 @@ Its cons cells are of the form
CONVERSION is the character code of a \"conversion specification\"
introduced by a `%' character in a control string."
- :type '(choice (const nil) function)
- :group 'battery)
+ :version "28.1"
+ :type '(choice (const nil) function))
(defcustom battery-echo-area-format
"Power %L, battery %B (%p%% load, remaining time %t)"
@@ -96,17 +135,20 @@ string are substituted as defined by the current value of the variable
`battery-status-function'. Here are the ones generally available:
%c Current capacity (mAh or mWh)
%r Current rate of charge or discharge
+%L AC line status (verbose)
%B Battery status (verbose)
%b Battery status: empty means high, `-' means low,
`!' means critical, and `+' means charging
%d Temperature (in degrees Celsius)
-%L AC line status (verbose)
%p Battery load percentage
+%s Remaining time (to charge or discharge) in seconds
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
-%t Remaining time (to charge or discharge) in the form `h:min'"
- :type '(choice string (const nil))
- :group 'battery)
+%t Remaining time (to charge or discharge) in the form `h:min'
+
+The full `format-spec' formatting syntax is supported."
+ :link '(info-link "(elisp) Custom Format Strings")
+ :type '(choice string (const nil)))
(defvar battery-mode-line-string nil
"String to display in the mode line.")
@@ -115,11 +157,10 @@ string are substituted as defined by the current value of the variable
(defcustom battery-mode-line-limit 100
"Percentage of full battery load below which display battery status."
:version "24.1"
- :type 'integer
- :group 'battery)
+ :type 'integer)
(defcustom battery-mode-line-format
- (cond ((eq battery-status-function 'battery-linux-proc-acpi)
+ (cond ((eq battery-status-function #'battery-linux-proc-acpi)
"[%b%p%%,%d°C]")
(battery-status-function
"[%b%p%%]"))
@@ -130,34 +171,46 @@ string are substituted as defined by the current value of the variable
`battery-status-function'. Here are the ones generally available:
%c Current capacity (mAh or mWh)
%r Current rate of charge or discharge
+%L AC line status (verbose)
%B Battery status (verbose)
%b Battery status: empty means high, `-' means low,
`!' means critical, and `+' means charging
%d Temperature (in degrees Celsius)
-%L AC line status (verbose)
%p Battery load percentage
+%s Remaining time (to charge or discharge) in seconds
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
-%t Remaining time (to charge or discharge) in the form `h:min'"
- :type '(choice string (const nil))
- :group 'battery)
+%t Remaining time (to charge or discharge) in the form `h:min'
+
+The full `format-spec' formatting syntax is supported."
+ :link '(info-link "(elisp) Custom Format Strings")
+ :type '(choice string (const nil)))
(defcustom battery-update-interval 60
"Seconds after which the battery status will be updated."
- :type 'integer
- :group 'battery)
+ :type 'integer)
(defcustom battery-load-low 25
"Upper bound of low battery load percentage.
A battery load percentage below this number is considered low."
- :type 'integer
- :group 'battery)
+ :type 'integer)
(defcustom battery-load-critical 10
"Upper bound of critical battery load percentage.
A battery load percentage below this number is considered critical."
- :type 'integer
- :group 'battery)
+ :type 'integer)
+
+(defface battery-load-low
+ '((t :inherit warning))
+ "Face used in mode line string when battery load is low.
+See the option `battery-load-low'."
+ :version "28.1")
+
+(defface battery-load-critical
+ '((t :inherit error))
+ "Face used in mode line string when battery load is critical.
+See the option `battery-load-critical'."
+ :version "28.1")
(defvar battery-update-timer nil
"Interval timer object.")
@@ -181,17 +234,21 @@ The text displayed in the mode line is controlled by
`battery-mode-line-format' and `battery-status-function'.
The mode line is be updated every `battery-update-interval'
seconds."
- :global t :group 'battery
+ :global t
(setq battery-mode-line-string "")
(or global-mode-string (setq global-mode-string '("")))
(and battery-update-timer (cancel-timer battery-update-timer))
+ (battery--upower-unsubscribe)
(if (and battery-status-function battery-mode-line-format)
(if (not display-battery-mode)
(setq global-mode-string
(delq 'battery-mode-line-string global-mode-string))
(add-to-list 'global-mode-string 'battery-mode-line-string t)
+ (and (eq battery-status-function #'battery-upower)
+ battery-upower-subscribe
+ (battery--upower-subsribe))
(setq battery-update-timer (run-at-time nil battery-update-interval
- 'battery-update-handler))
+ #'battery-update-handler))
(battery-update))
(message "Battery status not available")
(setq display-battery-mode nil)))
@@ -203,34 +260,42 @@ seconds."
(defun battery-update ()
"Update battery status information in the mode line."
(let* ((data (and battery-status-function (funcall battery-status-function)))
- (percentage (car (read-from-string (cdr (assq ?p data))))))
- (setq battery-mode-line-string
- (propertize (if (and battery-mode-line-format
- (numberp percentage)
- (<= percentage battery-mode-line-limit))
- (battery-format battery-mode-line-format data)
- "")
- 'face
- (and (numberp percentage)
- (<= percentage battery-load-critical)
- 'error)
- 'help-echo "Battery status information")))
- (force-mode-line-update))
+ (percentage (car (read-from-string (cdr (assq ?p data)))))
+ (res (and battery-mode-line-format
+ (or (not (numberp percentage))
+ (<= percentage battery-mode-line-limit))
+ (battery-format battery-mode-line-format data)))
+ (len (length res)))
+ (unless (zerop len)
+ (cond ((not (numberp percentage)))
+ ((< percentage battery-load-critical)
+ (add-face-text-property 0 len 'battery-load-critical t res))
+ ((< percentage battery-load-low)
+ (add-face-text-property 0 len 'battery-load-low t res)))
+ (put-text-property 0 len 'help-echo "Battery status information" res))
+ (setq battery-mode-line-string (or res "")))
+ (force-mode-line-update t))
+
;;; `/proc/apm' interface for Linux.
-(defconst battery-linux-proc-apm-regexp
- (concat "^\\([^ ]+\\)" ; Driver version.
- " \\([^ ]+\\)" ; APM BIOS version.
- " 0x\\([0-9a-f]+\\)" ; APM BIOS flags.
- " 0x\\([0-9a-f]+\\)" ; AC line status.
- " 0x\\([0-9a-f]+\\)" ; Battery status.
- " 0x\\([0-9a-f]+\\)" ; Battery flags.
- " \\(-?[0-9]+\\)%" ; Load percentage.
- " \\(-?[0-9]+\\)" ; Remaining time.
- " \\(.*\\)" ; Time unit.
- "$")
+;; Regular expression matching contents of `/proc/apm'.
+(rx-define battery--linux-proc-apm
+ (: bol (group (+ (not ?\s))) ; Driver version.
+ " " (group (+ (not ?\s))) ; APM BIOS version.
+ " 0x" (group (+ xdigit)) ; APM BIOS flags.
+ " 0x" (group (+ xdigit)) ; AC line status.
+ " 0x" (group (+ xdigit)) ; Battery status.
+ " 0x" (group (+ xdigit)) ; Battery flags.
+ " " (group (? ?-) (+ digit)) ?% ; Load percentage.
+ " " (group (? ?-) (+ digit)) ; Remaining time.
+ " " (group (* nonl)) ; Time unit
+ eol))
+
+(defconst battery-linux-proc-apm-regexp (rx battery--linux-proc-apm)
"Regular expression matching contents of `/proc/apm'.")
+(make-obsolete-variable 'battery-linux-proc-apm-regexp
+ "it is no longer used." "28.1")
(defun battery-linux-proc-apm ()
"Get APM status information from Linux (the kernel).
@@ -250,12 +315,12 @@ The following %-sequences are provided:
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
%t Remaining time (to charge or discharge) in the form `h:min'"
- (let (driver-version bios-version bios-interface line-status
- battery-status battery-status-symbol load-percentage
- seconds minutes hours remaining-time tem)
+ (let ( driver-version bios-version bios-interface line-status
+ battery-status battery-status-symbol load-percentage
+ seconds minutes hours remaining-time tem )
(with-temp-buffer
(ignore-errors (insert-file-contents "/proc/apm"))
- (when (re-search-forward battery-linux-proc-apm-regexp)
+ (when (re-search-forward (rx battery--linux-proc-apm) nil t)
(setq driver-version (match-string 1))
(setq bios-version (match-string 2))
(setq tem (string-to-number (match-string 3) 16))
@@ -268,9 +333,7 @@ The following %-sequences are provided:
(cond ((= tem 0) (setq line-status "off-line"))
((= tem 1) (setq line-status "on-line"))
((= tem 2) (setq line-status "on backup")))
- (setq tem (string-to-number (match-string 6) 16))
- (if (= tem 255)
- (setq battery-status "N/A")
+ (unless (= (string-to-number (match-string 6) 16) 255)
(setq tem (string-to-number (match-string 5) 16))
(cond ((= tem 0) (setq battery-status "high"
battery-status-symbol ""))
@@ -287,7 +350,7 @@ The following %-sequences are provided:
(setq minutes (/ seconds 60)
hours (/ seconds 3600))
(setq remaining-time
- (format "%d:%02d" hours (- minutes (* 60 hours))))))))
+ (format "%d:%02d" hours (% minutes 60)))))))
(list (cons ?v (or driver-version "N/A"))
(cons ?V (or bios-version "N/A"))
(cons ?I (or bios-interface "N/A"))
@@ -295,27 +358,31 @@ The following %-sequences are provided:
(cons ?B (or battery-status "N/A"))
(cons ?b (or battery-status-symbol ""))
(cons ?p (or load-percentage "N/A"))
- (cons ?s (or (and seconds (number-to-string seconds)) "N/A"))
- (cons ?m (or (and minutes (number-to-string minutes)) "N/A"))
- (cons ?h (or (and hours (number-to-string hours)) "N/A"))
+ (cons ?s (if seconds (number-to-string seconds) "N/A"))
+ (cons ?m (if minutes (number-to-string minutes) "N/A"))
+ (cons ?h (if hours (number-to-string hours) "N/A"))
(cons ?t (or remaining-time "N/A")))))
;;; `/proc/acpi/' interface for Linux.
+(rx-define battery--acpi-rate (&rest hour)
+ (: (group (+ digit)) " " (group ?m (in "AW") hour)))
+(rx-define battery--acpi-capacity (battery--acpi-rate ?h))
+
(defun battery-linux-proc-acpi ()
"Get ACPI status information from Linux (the kernel).
-This function works only with the `/proc/acpi/' format introduced
-in Linux version 2.4.20 and 2.6.0.
+This function works only with the `/proc/acpi/' interface
+introduced in Linux version 2.4.20 and 2.6.0.
The following %-sequences are provided:
%c Current capacity (mAh)
-%r Current rate
+%r Current rate of charge or discharge
+%L AC line status (verbose)
%B Battery status (verbose)
%b Battery status, empty means high, `-' means low,
`!' means critical, and `+' means charging
%d Temperature (in degrees Celsius)
-%L AC line status (verbose)
%p Battery load percentage
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
@@ -331,45 +398,51 @@ The following %-sequences are provided:
;; information together since displaying for a variable amount of
;; batteries seems overkill for format-strings.
(with-temp-buffer
- (dolist (dir (ignore-errors (directory-files "/proc/acpi/battery/"
- t "\\`[^.]")))
- (erase-buffer)
- (ignore-errors (insert-file-contents (expand-file-name "state" dir)))
- (when (re-search-forward "present: +yes$" nil t)
- (and (re-search-forward "charging state: +\\(.*\\)$" nil t)
+ (dolist (dir (battery--files "/proc/acpi/battery/"))
+ (ignore-errors
+ (insert-file-contents (expand-file-name "state" dir) nil nil nil t))
+ (goto-char (point-min))
+ (when (re-search-forward (rx "present:" (+ space) "yes" eol) nil t)
+ (and (re-search-forward (rx "charging state:" (+ space)
+ (group (not space) (* nonl)) eol)
+ nil t)
(member charging-state '("unknown" "charged" nil))
;; On most multi-battery systems, most of the time only one
;; battery is "charging"/"discharging", the others are
;; "unknown".
(setq charging-state (match-string 1)))
- (when (re-search-forward "present rate: +\\([0-9]+\\) \\(m[AW]\\)$"
+ (when (re-search-forward (rx "present rate:" (+ space)
+ (battery--acpi-rate) eol)
nil t)
(setq rate (+ (or rate 0) (string-to-number (match-string 1))))
(when (> rate 0)
- (setq rate-type (or (and rate-type
- (if (string= rate-type (match-string 2))
- rate-type
- (error
- "Inconsistent rate types (%s vs. %s)"
- rate-type (match-string 2))))
- (match-string 2)))))
- (when (re-search-forward "remaining capacity: +\\([0-9]+\\) m[AW]h$"
+ (cond ((not rate-type)
+ (setq rate-type (match-string 2)))
+ ((not (string= rate-type (match-string 2)))
+ (error "Inconsistent rate types (%s vs. %s)"
+ rate-type (match-string 2))))))
+ (when (re-search-forward (rx "remaining capacity:" (+ space)
+ battery--acpi-capacity eol)
nil t)
(setq capacity
(+ (or capacity 0) (string-to-number (match-string 1))))))
(goto-char (point-max))
(ignore-errors (insert-file-contents (expand-file-name "info" dir)))
- (when (re-search-forward "present: +yes$" nil t)
- (when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$"
+ (when (re-search-forward (rx "present:" (+ space) "yes" eol) nil t)
+ (when (re-search-forward (rx "design capacity:" (+ space)
+ battery--acpi-capacity eol)
nil t)
(cl-incf design-capacity (string-to-number (match-string 1))))
- (when (re-search-forward "last full capacity: +\\([0-9]+\\) m[AW]h$"
+ (when (re-search-forward (rx "last full capacity:" (+ space)
+ battery--acpi-capacity eol)
nil t)
(cl-incf last-full-capacity (string-to-number (match-string 1))))
- (when (re-search-forward
- "design capacity warning: +\\([0-9]+\\) m[AW]h$" nil t)
+ (when (re-search-forward (rx "design capacity warning:" (+ space)
+ battery--acpi-capacity eol)
+ nil t)
(cl-incf warn (string-to-number (match-string 1))))
- (when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$"
+ (when (re-search-forward (rx "design capacity low:" (+ space)
+ battery--acpi-capacity eol)
nil t)
(cl-incf low (string-to-number (match-string 1)))))))
(setq full-capacity (if (> last-full-capacity 0)
@@ -383,77 +456,70 @@ The following %-sequences are provided:
60)
rate))
hours (/ minutes 60)))
- (list (cons ?c (or (and capacity (number-to-string capacity)) "N/A"))
+ (list (cons ?c (if capacity (number-to-string capacity) "N/A"))
(cons ?L (or (battery-search-for-one-match-in-files
- (mapcar (lambda (e) (concat e "/state"))
- (ignore-errors
- (directory-files "/proc/acpi/ac_adapter/"
- t "\\`[^.]")))
- "state: +\\(.*\\)$" 1)
-
+ (mapcar (lambda (d) (expand-file-name "state" d))
+ (battery--files "/proc/acpi/ac_adapter/"))
+ (rx "state:" (+ space) (group (not space) (* nonl)) eol)
+ 1)
"N/A"))
(cons ?d (or (battery-search-for-one-match-in-files
- (mapcar (lambda (e) (concat e "/temperature"))
- (ignore-errors
- (directory-files "/proc/acpi/thermal_zone/"
- t "\\`[^.]")))
- "temperature: +\\([0-9]+\\) C$" 1)
-
+ (mapcar (lambda (d) (expand-file-name "temperature" d))
+ (battery--files "/proc/acpi/thermal_zone/"))
+ (rx "temperature:" (+ space) (group (+ digit)) " C" eol)
+ 1)
"N/A"))
- (cons ?r (or (and rate (concat (number-to-string rate) " "
- rate-type)) "N/A"))
+ (cons ?r (if rate
+ (concat (number-to-string rate) " " rate-type)
+ "N/A"))
(cons ?B (or charging-state "N/A"))
- (cons ?b (or (and (string= charging-state "charging") "+")
- (and capacity (< capacity low) "!")
- (and capacity (< capacity warn) "-")
- ""))
- (cons ?h (or (and hours (number-to-string hours)) "N/A"))
- (cons ?m (or (and minutes (number-to-string minutes)) "N/A"))
- (cons ?t (or (and minutes
- (format "%d:%02d" hours (- minutes (* 60 hours))))
- "N/A"))
- (cons ?p (or (and full-capacity capacity
- (> full-capacity 0)
- (number-to-string
- (floor (* 100 capacity) full-capacity)))
- "N/A")))))
+ (cons ?b (cond ((string= charging-state "charging") "+")
+ ((and capacity (< capacity low)) "!")
+ ((and capacity (< capacity warn)) "-")
+ ("")))
+ (cons ?h (if hours (number-to-string hours) "N/A"))
+ (cons ?m (if minutes (number-to-string minutes) "N/A"))
+ (cons ?t (if minutes (format "%d:%02d" hours (% minutes 60)) "N/A"))
+ (cons ?p (if (and full-capacity capacity (> full-capacity 0))
+ (number-to-string (floor (* 100 capacity) full-capacity))
+ "N/A")))))
;;; `/sys/class/power_supply/BATN' interface for Linux.
(defun battery-linux-sysfs ()
- "Get ACPI status information from Linux kernel.
+ "Get sysfs status information from Linux kernel.
This function works only with the new `/sys/class/power_supply/'
-format introduced in Linux version 2.4.25.
+interface introduced in Linux version 2.4.25.
The following %-sequences are provided:
%c Current capacity (mAh or mWh)
-%r Current rate
+%r Current rate of charge or discharge
+%L Power source (verbose)
%B Battery status (verbose)
+%b Battery status, empty means high, `-' means low,
+ `!' means critical, and `+' means charging
%d Temperature (in degrees Celsius)
%p Battery load percentage
-%L AC line status (verbose)
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
%t Remaining time (to charge or discharge) in the form `h:min'"
- (let (charging-state temperature hours
- ;; Some batteries report charges and current, other energy and power.
+ (let (;; Some batteries report charges and current, others energy and power.
;; In order to reliably be able to combine those data, we convert them
;; all to energy/power (since we can't combine different charges if
;; they're not at the same voltage).
(energy-full 0.0)
(energy-now 0.0)
(power-now 0.0)
- (voltage-now 10.8)) ;Arbitrary default, in case the info is missing.
+ (voltage-now 10.8) ; Arbitrary default, in case the info is missing.
+ charging-state temperature hours percentage-now)
;; SysFS provides information about each battery present in the
;; system in a separate subdirectory. We are going to merge the
;; available information together.
(with-temp-buffer
- (dolist (dir (ignore-errors
- (battery--find-linux-sysfs-batteries)))
- (erase-buffer)
- (ignore-errors (insert-file-contents
- (expand-file-name "uevent" dir)))
+ (dolist (dir (battery--find-linux-sysfs-batteries))
+ (ignore-errors
+ (insert-file-contents (expand-file-name "uevent" dir) nil nil nil t))
(goto-char (point-min))
(when (re-search-forward
"POWER_SUPPLY_VOLTAGE_NOW=\\([0-9]*\\)$" nil t)
@@ -489,7 +555,7 @@ The following %-sequences are provided:
voltage-now))
(cl-incf energy-now (* (string-to-number now-string)
voltage-now)))
- ((and (progn (goto-char (point-min)) t)
+ ((and (goto-char (point-min))
(re-search-forward
"POWER_SUPPLY_ENERGY_FULL=\\([0-9]*\\)$" nil t)
(setq full-string (match-string 1))
@@ -498,15 +564,16 @@ The following %-sequences are provided:
(setq now-string (match-string 1)))
(cl-incf energy-full (string-to-number full-string))
(cl-incf energy-now (string-to-number now-string)))))
- (goto-char (point-min))
(unless (zerop power-now)
(let ((remaining (if (string= charging-state "Discharging")
energy-now
(- energy-full energy-now))))
(setq hours (/ remaining power-now)))))))
- (list (cons ?c (cond ((or (> energy-full 0) (> energy-now 0))
- (number-to-string (/ energy-now voltage-now)))
- (t "N/A")))
+ (when (and (> energy-full 0) (> energy-now 0))
+ (setq percentage-now (/ (* 100 energy-now) energy-full)))
+ (list (cons ?c (if (or (> energy-full 0) (> energy-now 0))
+ (number-to-string (/ energy-now voltage-now))
+ "N/A"))
(cons ?r (if (> power-now 0.0)
(format "%.1f" (/ power-now 1000000.0))
"N/A"))
@@ -517,104 +584,205 @@ The following %-sequences are provided:
"N/A"))
(cons ?d (or temperature "N/A"))
(cons ?B (or charging-state "N/A"))
- (cons ?p (cond ((and (> energy-full 0) (> energy-now 0))
- (format "%.1f"
- (/ (* 100 energy-now) energy-full)))
- (t "N/A")))
- (cons ?L (cond
- ((battery-search-for-one-match-in-files
- (list "/sys/class/power_supply/AC/online"
- "/sys/class/power_supply/ACAD/online"
- "/sys/class/power_supply/ADP1/online")
- "1" 0)
- "AC")
- ((battery-search-for-one-match-in-files
- (list "/sys/class/power_supply/AC/online"
- "/sys/class/power_supply/ACAD/online"
- "/sys/class/power_supply/ADP1/online")
- "0" 0)
- "BAT")
- (t "N/A"))))))
+ (cons ?b (cond ((string= charging-state "Charging") "+")
+ ((not percentage-now) "")
+ ((< percentage-now battery-load-critical) "!")
+ ((< percentage-now battery-load-low) "-")
+ ("")))
+ (cons ?p (if percentage-now (format "%.1f" percentage-now) "N/A"))
+ (cons ?L (pcase (battery-search-for-one-match-in-files
+ '("/sys/class/power_supply/AC/online"
+ "/sys/class/power_supply/ACAD/online"
+ "/sys/class/power_supply/ADP1/online")
+ (rx (in "01")) 0)
+ ("0" "BAT")
+ ("1" "AC")
+ (_ "N/A"))))))
-(declare-function dbus-get-property "dbus.el"
- (bus service path interface property))
-
-;;; `upowerd' interface.
-(defsubst battery-upower-prop (pname &optional device)
- (dbus-get-property
- :system
- "org.freedesktop.UPower"
- (concat "/org/freedesktop/UPower/devices/" (or device battery-upower-device))
- "org.freedesktop.UPower"
- pname))
+;;; UPower interface.
+
+(defconst battery-upower-interface "org.freedesktop.UPower"
+ "Name of the UPower D-Bus interface.
+See URL `https://upower.freedesktop.org/docs/UPower.html'.")
+
+(defconst battery-upower-path "/org/freedesktop/UPower"
+ "D-Bus object providing `battery-upower-interface'.")
+
+(defconst battery-upower-device-interface "org.freedesktop.UPower.Device"
+ "Name of the UPower Device D-Bus interface.
+See URL `https://upower.freedesktop.org/docs/Device.html'.")
+
+(defconst battery-upower-device-path "/org/freedesktop/UPower/devices"
+ "D-Bus object providing `battery-upower-device-interface'.")
+
+(defvar battery--upower-signals nil
+ "Handles for UPower signal subscriptions.")
+
+(defun battery--upower-signal-handler (&rest _)
+ "Update battery status on receiving a UPower D-Bus signal."
+ (timer-event-handler battery-update-timer))
+
+(defun battery--upower-props-changed (_interface changed _invalidated)
+ "Update status when system starts/stops running on battery.
+Intended as a UPower PropertiesChanged signal handler."
+ (when (assoc "OnBattery" changed)
+ (battery--upower-signal-handler)))
+
+(defun battery--upower-unsubscribe ()
+ "Unsubscribe from UPower device change signals."
+ (mapc #'dbus-unregister-object battery--upower-signals)
+ (setq battery--upower-signals ()))
+
+(defun battery--upower-subsribe ()
+ "Subscribe to UPower device change signals."
+ (push (dbus-register-signal :system battery-upower-service
+ battery-upower-path
+ dbus-interface-properties
+ "PropertiesChanged"
+ #'battery--upower-props-changed)
+ battery--upower-signals)
+ (dolist (method '("DeviceAdded" "DeviceRemoved"))
+ (push (dbus-register-signal :system battery-upower-service
+ battery-upower-path
+ battery-upower-interface
+ method #'battery--upower-signal-handler)
+ battery--upower-signals)))
+
+(defun battery--upower-device-properties (device)
+ "Return value for all available properties for the UPower DEVICE."
+ (dbus-get-all-properties
+ :system battery-upower-service
+ (expand-file-name device battery-upower-device-path)
+ battery-upower-device-interface))
+
+(defun battery--upower-devices ()
+ "List all UPower devices according to `battery-upower-device'."
+ (cond ((stringp battery-upower-device)
+ (list battery-upower-device))
+ (battery-upower-device)
+ ((dbus-call-method :system battery-upower-service
+ battery-upower-path
+ battery-upower-interface
+ "EnumerateDevices"))))
+
+(defun battery--upower-state (props state)
+ "Merge the UPower battery state in PROPS with STATE.
+This is an extension of the UPower DisplayDevice algorithm for
+merging multiple battery states into one. PROPS is an alist of
+battery properties from `battery-upower-device-interface', and
+STATE is a symbol representing the state to merge with."
+ ;; Map UPower enum into our printable symbols.
+ (let* ((new (pcase (cdr (assoc "State" props))
+ (1 'charging)
+ (2 'discharging)
+ (3 'empty)
+ (4 'fully-charged)
+ (5 'pending-charge)
+ (6 'pending-discharge)))
+ ;; Unknown state represented by nil.
+ (either (delq nil (list new state))))
+ ;; Earlier states override later ones.
+ (car (cond ((memq 'charging either))
+ ((memq 'discharging either))
+ ((memq 'pending-charge either))
+ ((memq 'pending-discharge either))
+ ;; Only options left are full or empty,
+ ;; but if they conflict return nil.
+ ((null (cdr either)) either)
+ ((apply #'eq either) either)))))
(defun battery-upower ()
- "Get battery status from dbus Upower interface.
-This function works only in systems with `upowerd' daemon
-running.
+ "Get battery status from UPower D-Bus interface.
+This function works only in systems that provide a UPower D-Bus
+service.
The following %-sequences are provided:
%c Current capacity (mWh)
-%p Battery load percentage
-%r Current rate
-%B Battery status (verbose)
+%r Current rate of charge or discharge
%L AC line status (verbose)
+%B Battery status (verbose)
+%b Battery status: empty means high, `-' means low,
+ `!' means critical, and `+' means charging
+%d Temperature (in degrees Celsius)
+%p Battery load percentage
%s Remaining time (to charge or discharge) in seconds
%m Remaining time (to charge or discharge) in minutes
%h Remaining time (to charge or discharge) in hours
%t Remaining time (to charge or discharge) in the form `h:min'"
- (let ((percents (battery-upower-prop "Percentage"))
- (time-to-empty (battery-upower-prop "TimeToEmpty"))
- (time-to-full (battery-upower-prop "TimeToFull"))
- (state (battery-upower-prop "State"))
- (online (battery-upower-prop "Online" "line_power_ACAD"))
- (energy (battery-upower-prop "Energy"))
- (energy-rate (battery-upower-prop "EnergyRate"))
- (battery-states '((0 . "unknown") (1 . "charging")
- (2 . "discharging") (3 . "empty")
- (4 . "fully-charged") (5 . "pending-charge")
- (6 . "pending-discharge")))
- seconds minutes hours remaining-time)
- (cond ((and online time-to-full)
- (setq seconds time-to-full))
- ((and (not online) time-to-empty)
- (setq seconds time-to-empty)))
- (when seconds
- (setq minutes (/ seconds 60)
- hours (/ minutes 60)
- remaining-time (format "%d:%02d" hours (mod minutes 60))))
- (list (cons ?c (or (and energy
- (number-to-string (round (* 1000 energy))))
- "N/A"))
- (cons ?p (or (and percents (number-to-string (round percents)))
- "N/A"))
- (cons ?r (or (and energy-rate
- (concat (number-to-string energy-rate) " W"))
- "N/A"))
- (cons ?B (or (and state (cdr (assoc state battery-states)))
- "unknown"))
- (cons ?L (or (and online "on-line") "off-line"))
- (cons ?s (or (and seconds (number-to-string seconds)) "N/A"))
- (cons ?m (or (and minutes (number-to-string minutes)) "N/A"))
- (cons ?h (or (and hours (number-to-string hours)) "N/A"))
- (cons ?t (or remaining-time "N/A")))))
+ (let ((count 0) props type line-status state load temperature
+ secs mins hrs total-energy total-rate total-tte total-ttf)
+ ;; Merge information from all available or specified UPower
+ ;; devices like other `battery-status-function's.
+ (dolist (device (battery--upower-devices))
+ (setq props (battery--upower-device-properties device))
+ (setq type (cdr (assoc "Type" props)))
+ (cond
+ ((and (eq type 1) (not (eq line-status 'online)))
+ ;; It's a line power device: `online' if currently providing
+ ;; power, any other non-nil value if simply present.
+ (setq line-status (if (cdr (assoc "Online" props)) 'online t)))
+ ((and (eq type 2) (cdr (assoc "IsPresent" props)))
+ ;; It's a battery.
+ (setq count (1+ count))
+ (setq state (battery--upower-state props state))
+ (let ((energy (cdr (assoc "Energy" props)))
+ (rate (cdr (assoc "EnergyRate" props)))
+ (percent (cdr (assoc "Percentage" props)))
+ (temp (cdr (assoc "Temperature" props)))
+ (tte (cdr (assoc "TimeToEmpty" props)))
+ (ttf (cdr (assoc "TimeToFull" props))))
+ (when energy (setq total-energy (+ (or total-energy 0) energy)))
+ (when rate (setq total-rate (+ (or total-rate 0) rate)))
+ (when percent (setq load (+ (or load 0) percent)))
+ (when temp (setq temperature (+ (or temperature 0) temp)))
+ (when tte (setq total-tte (+ (or total-tte 0) tte)))
+ (when ttf (setq total-ttf (+ (or total-ttf 0) ttf)))))))
+ (when (> count 1)
+ ;; Averages over multiple batteries.
+ (when load (setq load (/ load count)))
+ (when temperature (setq temperature (/ temperature count))))
+ (when (setq secs (if (eq line-status 'online) total-ttf total-tte))
+ (setq mins (/ secs 60))
+ (setq hrs (/ secs 3600)))
+ (list (cons ?c (if total-energy
+ (format "%.0f" (* total-energy 1000))
+ "N/A"))
+ (cons ?r (if total-rate (format "%.1f W" total-rate) "N/A"))
+ (cons ?L (cond ((eq line-status 'online) "on-line")
+ (line-status "off-line")
+ ("N/A")))
+ (cons ?B (format "%s" (or state 'unknown)))
+ (cons ?b (cond ((eq state 'charging) "+")
+ ((and load (< load battery-load-critical)) "!")
+ ((and load (< load battery-load-low)) "-")
+ ("")))
+ ;; Zero usually means unknown.
+ (cons ?d (if (and temperature (/= temperature 0))
+ (format "%.0f" temperature)
+ "N/A"))
+ (cons ?p (if load (format "%.0f" load) "N/A"))
+ (cons ?s (if secs (number-to-string secs) "N/A"))
+ (cons ?m (if mins (number-to-string mins) "N/A"))
+ (cons ?h (if hrs (number-to-string hrs) "N/A"))
+ (cons ?t (if hrs (format "%d:%02d" hrs (% mins 60)) "N/A")))))
;;; `apm' interface for BSD.
+
(defun battery-bsd-apm ()
"Get APM status information from BSD apm binary.
The following %-sequences are provided:
+%P Advanced power saving mode state (verbose)
%L AC line status (verbose)
%B Battery status (verbose)
%b Battery status, empty means high, `-' means low,
- `!' means critical, and `+' means charging
-%P Advanced power saving mode state (verbose)
-%p Battery charge percentage
-%s Remaining battery charge time in seconds
-%m Remaining battery charge time in minutes
-%h Remaining battery charge time in hours
-%t Remaining battery charge time in the form `h:min'"
+ `!' means critical, and `+' means charging
+%p Battery load percentage
+%s Remaining time (to charge or discharge) in seconds
+%m Remaining time (to charge or discharge) in minutes
+%h Remaining time (to charge or discharge) in hours
+%t Remaining time (to charge or discharge) in the form `h:min'"
(let* ((os-name (car (split-string
;; FIXME: Can't we use something like `system-type'?
(shell-command-to-string "/usr/bin/uname"))))
@@ -680,7 +848,7 @@ The following %-sequences are provided:
(setq seconds (string-to-number battery-life)
minutes (truncate seconds 60)))
(setq hours (truncate minutes 60)
- remaining-time (format "%d:%02d" hours (mod minutes 60))))
+ remaining-time (format "%d:%02d" hours (% minutes 60))))
(list (cons ?L (or line-status "N/A"))
(cons ?B (or (car battery-status) "N/A"))
(cons ?b (or (cdr battery-status) "N/A"))
@@ -688,9 +856,9 @@ The following %-sequences are provided:
"N/A"
battery-percentage))
(cons ?P (or apm-mode "N/A"))
- (cons ?s (or (and seconds (number-to-string seconds)) "N/A"))
- (cons ?m (or (and minutes (number-to-string minutes)) "N/A"))
- (cons ?h (or (and hours (number-to-string hours)) "N/A"))
+ (cons ?s (if seconds (number-to-string seconds) "N/A"))
+ (cons ?m (if minutes (number-to-string minutes) "N/A"))
+ (cons ?h (if hours (number-to-string hours) "N/A"))
(cons ?t (or remaining-time "N/A")))))
@@ -705,21 +873,25 @@ The following %-sequences are provided:
%b Battery status, empty means high, `-' means low,
`!' means critical, and `+' means charging
%p Battery load percentage
-%h Remaining time in hours
-%m Remaining time in minutes
-%t Remaining time in the form `h:min'"
- (let (power-source load-percentage battery-status battery-status-symbol
- remaining-time hours minutes)
+%m Remaining time (to charge or discharge) in minutes
+%h Remaining time (to charge or discharge) in hours
+%t Remaining time (to charge or discharge) in the form `h:min'"
+ (let ( power-source load-percentage battery-status battery-status-symbol
+ remaining-time hours minutes )
(with-temp-buffer
(ignore-errors (call-process "pmset" nil t nil "-g" "ps"))
(goto-char (point-min))
- (when (re-search-forward "\\(?:Currentl?y\\|Now\\) drawing from '\\(AC\\|Battery\\) Power'" nil t)
+ (when (re-search-forward ;; Handle old typo in output.
+ "\\(?:Currentl?y\\|Now\\) drawing from '\\(AC\\|Battery\\) Power'"
+ nil t)
(setq power-source (match-string 1))
- (when (re-search-forward "^ -InternalBattery-0\\([ \t]+(id=[0-9]+)\\)*[ \t]+" nil t)
+ (when (re-search-forward (rx bol " -InternalBattery-0" (+ space)
+ (* "(id=" (+ digit) ")" (+ space)))
+ nil t)
(when (looking-at "\\([0-9]\\{1,3\\}\\)%")
(setq load-percentage (match-string 1))
(goto-char (match-end 0))
- (cond ((looking-at "; charging")
+ (cond ((looking-at-p "; charging")
(setq battery-status "charging"
battery-status-symbol "+"))
((< (string-to-number load-percentage) battery-load-critical)
@@ -750,13 +922,7 @@ The following %-sequences are provided:
(defun battery-format (format alist)
"Substitute %-sequences in FORMAT."
- (replace-regexp-in-string
- "%."
- (lambda (str)
- (let ((char (aref str 1)))
- (if (eq char ?%) "%"
- (or (cdr (assoc char alist)) ""))))
- format t t))
+ (format-spec format alist 'delete))
(defun battery-search-for-one-match-in-files (files regexp match-num)
"Search REGEXP in the content of the files listed in FILES.
diff --git a/lisp/bindings.el b/lisp/bindings.el
index e3fc5637fab..250234e94c1 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -411,6 +411,8 @@ zero, otherwise they start from one."
:type 'boolean
:group 'mode-line
:version "26.1")
+(make-obsolete-variable 'column-number-indicator-zero-based
+ 'mode-line-position-column-format "28.1")
(defcustom mode-line-percent-position '(-3 "%p")
"Specification of \"percentage offset\" of window through buffer.
@@ -431,6 +433,41 @@ displayed in `mode-line-position', a component of the default
:group 'mode-line)
(put 'mode-line-percent-position 'risky-local-variable t)
+(defcustom mode-line-position-line-format '(" L%l")
+ "Format used to display line numbers in the mode line.
+This is used when `line-number-mode' is switched on. The \"%l\"
+format spec will be replaced by the line number."
+ :type '(list string)
+ :version "28.1"
+ :group 'mode-line)
+
+(defcustom mode-line-position-column-format '(" C%c")
+ "Format used to display column numbers in the mode line.
+This is used when `column-number-mode' is switched on. The
+\"%c\" format spec will be replaced by the column number, which
+is zero-based if `column-number-indicator-zero-based' is non-nil,
+and one-based if `column-number-indicator-zero-based' is nil."
+ :type '(list string)
+ :version "28.1"
+ :group 'mode-line)
+
+(defcustom mode-line-position-column-line-format '(" (%l,%c)")
+ "Format used to display combined line/column numbers in the mode line.
+This is used when `column-number-mode' and `line-number-mode' are
+switched on. The \"%c\" format spec will be replaced by the
+column number, which is zero-based if
+`column-number-indicator-zero-based' is non-nil, and one-based if
+`column-number-indicator-zero-based' is nil."
+ :type '(list string)
+ :version "28.1"
+ :group 'mode-line)
+
+(defconst mode-line-position--column-line-properties
+ (list 'local-map mode-line-column-line-number-mode-map
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Line number and Column number\n\
+mouse-1: Display Line and Column Mode Menu"))
+
(defvar mode-line-position
`((:propertize
mode-line-percent-position
@@ -450,38 +487,30 @@ mouse-1: Display Line and Column Mode Menu")))
(line-number-mode
((column-number-mode
(column-number-indicator-zero-based
- (10 ,(propertize
- " (%l,%c)"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line number and Column number\n\
-mouse-1: Display Line and Column Mode Menu"))
- (10 ,(propertize
- " (%l,%C)"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line number and Column number\n\
-mouse-1: Display Line and Column Mode Menu")))
- (6 ,(propertize
- " L%l"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Line Number\n\
-mouse-1: Display Line and Column Mode Menu"))))
- ((column-number-mode
- (column-number-indicator-zero-based
- (5 ,(propertize
- " C%c"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Column number\n\
-mouse-1: Display Line and Column Mode Menu"))
- (5 ,(propertize
- " C%C"
- 'local-map mode-line-column-line-number-mode-map
- 'mouse-face 'mode-line-highlight
- 'help-echo "Column number\n\
-mouse-1: Display Line and Column Mode Menu")))))))
+ (10
+ (:propertize
+ mode-line-position-column-line-format
+ ,@mode-line-position--column-line-properties))
+ (10
+ (:propertize
+ (:eval (string-replace
+ "%c" "%C" (car mode-line-position-column-line-format)))
+ ,@mode-line-position--column-line-properties)))
+ (6
+ (:propertize
+ mode-line-position-line-format
+ ,@mode-line-position--column-line-properties))))
+ (column-number-mode
+ (column-number-indicator-zero-based
+ (6
+ (:propertize
+ mode-line-position-column-format
+ (,@mode-line-position--column-line-properties)))
+ (6
+ (:propertize
+ (:eval (string-replace
+ "%c" "%C" (car mode-line-position-column-format)))
+ ,@mode-line-position--column-line-properties))))))
"Mode line construct for displaying the position in the buffer.
Normally displays the buffer percentage and, optionally, the
buffer size, the line number and the column number.")
@@ -889,6 +918,7 @@ if `inhibit-field-text-motion' is non-nil."
(define-key narrow-map "n" 'narrow-to-region)
(define-key narrow-map "w" 'widen)
+(define-key narrow-map "g" 'goto-line-relative)
;; Quitting
(define-key global-map "\e\e\e" 'keyboard-escape-quit)
@@ -1383,6 +1413,9 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map "'" 'expand-abbrev)
(define-key ctl-x-map "\C-b" 'list-buffers)
+(define-key ctl-x-map "\C-j" 'dired-jump)
+(define-key ctl-x-4-map "\C-j" 'dired-jump-other-window)
+
(define-key ctl-x-map "z" 'repeat)
(define-key esc-map "\C-l" 'reposition-window)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index e69d9f529cf..d703458aa11 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -32,6 +32,7 @@
;;; Code:
(require 'pp)
+(require 'tabulated-list)
(require 'text-property-search)
(eval-when-compile (require 'cl-lib))
@@ -126,16 +127,16 @@ recently set ones come first, oldest ones come last)."
(defconst bookmark-bmenu-buffer "*Bookmark List*"
"Name of buffer used for Bookmark List.")
-(defcustom bookmark-bmenu-use-header-line t
+(defvar bookmark-bmenu-use-header-line t
"Non-nil means to use an immovable header line.
-This is as opposed to inline text at the top of the buffer."
- :version "24.4"
- :type 'boolean)
+This is as opposed to inline text at the top of the buffer.")
+(make-obsolete-variable 'bookmark-bmenu-use-header-line "no longer used." "28.1")
(defconst bookmark-bmenu-inline-header-height 2
"Number of lines used for the *Bookmark List* header.
\(This is only significant when `bookmark-bmenu-use-header-line'
is nil.)")
+(make-obsolete-variable 'bookmark-bmenu-inline-header-height "no longer used." "28.1")
(defconst bookmark-bmenu-marks-width 2
"Number of columns (chars) used for the *Bookmark List* marks column.
@@ -165,6 +166,7 @@ A non-nil value may result in truncated bookmark names."
"Time before `bookmark-bmenu-search' updates the display."
:type 'number)
+;; FIXME: No longer used. Should be declared obsolete or removed.
(defface bookmark-menu-heading
'((t (:inherit font-lock-type-face)))
"Face used to highlight the heading in bookmark menu buffers."
@@ -200,6 +202,7 @@ A non-nil value may result in truncated bookmark names."
(define-key map "f" 'bookmark-insert-location) ;"f"ind
(define-key map "r" 'bookmark-rename)
(define-key map "d" 'bookmark-delete)
+ (define-key map "D" 'bookmark-delete-all)
(define-key map "l" 'bookmark-load)
(define-key map "w" 'bookmark-write)
(define-key map "s" 'bookmark-save)
@@ -734,8 +737,10 @@ CODING is the symbol of the coding-system in which the file is encoded."
(if (memq (coding-system-base coding) '(undecided prefer-utf-8))
(setq coding 'utf-8-emacs))
(insert
- (format ";;;; Emacs Bookmark Format Version %d ;;;; -*- coding: %S -*-\n"
- bookmark-file-format-version (coding-system-base coding)))
+ (format
+ ";;;; Emacs Bookmark Format Version %d\
+;;;; -*- coding: %S; mode: lisp-data -*-\n"
+ bookmark-file-format-version (coding-system-base coding)))
(insert ";;; This format is meant to be slightly human-readable;\n"
";;; nevertheless, you probably don't want to edit it.\n"
";;; "
@@ -800,7 +805,7 @@ still there, in order, if the topmost one is ever deleted."
(let ((str
(or name
(read-from-minibuffer
- (format "%s (default %s): " prompt default)
+ (format-prompt prompt default)
nil
bookmark-minibuffer-read-name-map
nil nil defaults))))
@@ -920,8 +925,6 @@ annotations."
"# Date: " (current-time-string) "\n"))
-(define-obsolete-variable-alias 'bookmark-read-annotation-text-func
- 'bookmark-edit-annotation-text-func "23.1")
(defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text
"Function to return default text to use for a bookmark annotation.
It takes one argument, the name of the bookmark, as a string.")
@@ -975,7 +978,7 @@ Lines beginning with `#' are ignored."
(when from-bookmark-list
(pop-to-buffer (get-buffer bookmark-bmenu-buffer))
(goto-char (point-min))
- (text-property-search-forward 'bookmark-name-prop bookmark-name))
+ (bookmark-bmenu-bookmark))
(kill-buffer old-buffer)))
@@ -1062,8 +1065,7 @@ it to the name of the bookmark currently being set, advancing
If `bookmark-sort-flag' is non-nil, then return a sorted copy of the alist."
(if bookmark-sort-flag
(sort (copy-alist bookmark-alist)
- (function
- (lambda (x y) (string-lessp (car x) (car y)))))
+ (lambda (x y) (string-lessp (car x) (car y))))
bookmark-alist))
@@ -1140,17 +1142,6 @@ DISPLAY-FUNC would be `switch-to-buffer-other-window'."
(let ((pop-up-frames t))
(bookmark-jump-other-window bookmark)))
-(defun bookmark-jump-noselect (bookmark)
- "Return the location pointed to by BOOKMARK (see `bookmark-jump').
-The return value has the form (BUFFER . POINT).
-
-Note: this function is deprecated and is present for Emacs 22
-compatibility only."
- (declare (obsolete bookmark-handle-bookmark "23.1"))
- (save-excursion
- (bookmark-handle-bookmark bookmark)
- (cons (current-buffer) (point))))
-
(defun bookmark-handle-bookmark (bookmark-name-or-record)
"Call BOOKMARK-NAME-OR-RECORD's handler or `bookmark-default-handler'
if it has none. This changes current buffer and point and returns nil,
@@ -1372,6 +1363,23 @@ probably because we were called from there."
(bookmark-save)))
+;;;###autoload
+(defun bookmark-delete-all (&optional no-confirm)
+ "Permanently delete all bookmarks.
+If optional argument NO-CONFIRM is non-nil, don't ask for
+confirmation."
+ (interactive "P")
+ (when (or no-confirm
+ (yes-or-no-p "Permanently delete all bookmarks? "))
+ (bookmark-maybe-load-default-file)
+ (setq bookmark-alist-modification-count
+ (+ bookmark-alist-modification-count (length bookmark-alist)))
+ (setq bookmark-alist nil)
+ (bookmark-bmenu-surreptitiously-rebuild-list)
+ (when (bookmark-time-to-save-p)
+ (bookmark-save))))
+
+
(defun bookmark-time-to-save-p (&optional final-time)
"Return t if it is time to save bookmarks to disk, nil otherwise.
Optional argument FINAL-TIME means this is being called when Emacs
@@ -1580,7 +1588,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
(defvar bookmark-bmenu-mode-map
(let ((map (make-keymap)))
- (set-keymap-parent map special-mode-map)
+ (set-keymap-parent map tabulated-list-mode-map)
(define-key map "v" 'bookmark-bmenu-select)
(define-key map "w" 'bookmark-bmenu-locate)
(define-key map "5" 'bookmark-bmenu-other-frame)
@@ -1598,12 +1606,13 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
(define-key map "\C-d" 'bookmark-bmenu-delete-backwards)
(define-key map "x" 'bookmark-bmenu-execute-deletions)
(define-key map "d" 'bookmark-bmenu-delete)
+ (define-key map "D" 'bookmark-bmenu-delete-all)
(define-key map " " 'next-line)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
(define-key map "\177" 'bookmark-bmenu-backup-unmark)
(define-key map "u" 'bookmark-bmenu-unmark)
+ (define-key map "U" 'bookmark-bmenu-unmark-all)
(define-key map "m" 'bookmark-bmenu-mark)
+ (define-key map "M" 'bookmark-bmenu-mark-all)
(define-key map "l" 'bookmark-bmenu-load)
(define-key map "r" 'bookmark-bmenu-rename)
(define-key map "R" 'bookmark-bmenu-relocate)
@@ -1625,8 +1634,10 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
["Select Marked Bookmarks" bookmark-bmenu-select t]
"---"
["Mark Bookmark" bookmark-bmenu-mark t]
+ ["Mark all Bookmarks" bookmark-bmenu-mark-all t]
["Unmark Bookmark" bookmark-bmenu-unmark t]
["Unmark Backwards" bookmark-bmenu-backup-unmark t]
+ ["Unmark all Bookmarks" bookmark-bmenu-unmark-all t]
["Toggle Display of Filenames" bookmark-bmenu-toggle-filenames t]
["Display Location of Bookmark" bookmark-bmenu-locate t]
"---"
@@ -1634,6 +1645,7 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
["Rename Bookmark" bookmark-bmenu-rename t]
["Relocate Bookmark's File" bookmark-bmenu-relocate t]
["Mark Bookmark for Deletion" bookmark-bmenu-delete t]
+ ["Mark all Bookmarks for Deletion" bookmark-bmenu-delete-all t]
["Delete Marked Bookmarks" bookmark-bmenu-execute-deletions t])
("Annotations"
["Show Annotation for Current Bookmark" bookmark-bmenu-show-annotation t]
@@ -1663,6 +1675,43 @@ Don't affect the buffer ring order."
(save-window-excursion
(bookmark-bmenu-list)))))
+(defun bookmark-bmenu--revert ()
+ "Re-populate `tabulated-list-entries'."
+ (let (entries)
+ (dolist (full-record (bookmark-maybe-sort-alist))
+ (let* ((name (bookmark-name-from-full-record full-record))
+ (annotation (bookmark-get-annotation full-record))
+ (location (bookmark-location full-record)))
+ (push (list
+ full-record
+ `[,(if (and annotation (not (string-equal annotation "")))
+ "*" "")
+ ,(if (display-mouse-p)
+ (propertize name
+ 'font-lock-face 'bookmark-menu-bookmark
+ 'mouse-face 'highlight
+ 'follow-link t
+ 'help-echo "mouse-2: go to this bookmark in other window")
+ name)
+ ,@(if bookmark-bmenu-toggle-filenames
+ (list location))])
+ entries)))
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries entries))
+ (tabulated-list-print t))
+
+;;;###autoload
+(defun bookmark-bmenu-get-buffer ()
+ "Return the Bookmark List, building it if it doesn't exists.
+Don't affect the buffer ring order."
+ (or (get-buffer bookmark-bmenu-buffer)
+ (save-excursion
+ (save-window-excursion
+ (bookmark-bmenu-list)
+ (get-buffer bookmark-bmenu-buffer)))))
+
+(custom-add-choice 'tab-bar-new-tab-choice
+ '(const :tag "Bookmark List" bookmark-bmenu-get-buffer))
;;;###autoload
(defun bookmark-bmenu-list ()
@@ -1676,76 +1725,25 @@ deletion, or > if it is flagged for displaying."
(if (called-interactively-p 'interactive)
(switch-to-buffer buf)
(set-buffer buf)))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (if (not bookmark-bmenu-use-header-line)
- (insert "% Bookmark\n- --------\n"))
- (add-text-properties (point-min) (point)
- '(font-lock-face bookmark-menu-heading))
- (dolist (full-record (bookmark-maybe-sort-alist))
- (let ((name (bookmark-name-from-full-record full-record))
- (annotation (bookmark-get-annotation full-record))
- (start (point))
- end)
- ;; if a bookmark has an annotation, prepend a "*"
- ;; in the list of bookmarks.
- (insert (if (and annotation (not (string-equal annotation "")))
- " *" " ")
- name)
- (setq end (point))
- (put-text-property
- (+ bookmark-bmenu-marks-width start) end 'bookmark-name-prop name)
- (when (display-mouse-p)
- (add-text-properties
- (+ bookmark-bmenu-marks-width start) end
- '(font-lock-face bookmark-menu-bookmark
- mouse-face highlight
- follow-link t
- help-echo "mouse-2: go to this bookmark in other window")))
- (insert "\n")))
- (set-buffer-modified-p (not (= bookmark-alist-modification-count 0)))
- (goto-char (point-min))
- (bookmark-bmenu-mode)
- (if bookmark-bmenu-use-header-line
- (bookmark-bmenu-set-header)
- (forward-line bookmark-bmenu-inline-header-height))
- (when (and bookmark-alist bookmark-bmenu-toggle-filenames)
- (bookmark-bmenu-toggle-filenames t))))
+ (bookmark-bmenu-mode)
+ (bookmark-bmenu--revert))
;;;###autoload
(defalias 'list-bookmarks 'bookmark-bmenu-list)
;;;###autoload
(defalias 'edit-bookmarks 'bookmark-bmenu-list)
-;; FIXME: This could also display the current default bookmark file
-;; according to `bookmark-bookmarks-timestamp'.
-(defun bookmark-bmenu-set-header ()
- "Set the immutable header line."
- (let ((header (concat "%% " "Bookmark")))
- (when bookmark-bmenu-toggle-filenames
- (setq header (concat header
- (make-string (- bookmark-bmenu-file-column
- (- (length header) 3)) ?\s)
- "File")))
- (let ((pos 0))
- (while (string-match "[ \t\n]+" header pos)
- (setq pos (match-end 0))
- (put-text-property (match-beginning 0) pos 'display
- (list 'space :align-to (- pos 1))
- header)))
- (put-text-property 0 2 'face 'fixed-pitch header)
- (setq header (concat (propertize " " 'display '(space :align-to 0))
- header))
- ;; Code derived from `buff-menu.el'.
- (setq header-line-format header)))
-
-(define-derived-mode bookmark-bmenu-mode special-mode "Bookmark Menu"
+(define-obsolete-function-alias 'bookmark-bmenu-set-header
+ #'tabulated-list-init-header "28.1")
+
+(define-derived-mode bookmark-bmenu-mode tabulated-list-mode "Bookmark Menu"
"Major mode for editing a list of bookmarks.
Each line describes one of the bookmarks in Emacs.
Letters do not insert themselves; instead, they are commands.
Bookmark names preceded by a \"*\" have annotations.
\\<bookmark-bmenu-mode-map>
\\[bookmark-bmenu-mark] -- mark bookmark to be displayed.
+\\[bookmark-bmenu-mark-all] -- mark all listed bookmarks to be displayed.
\\[bookmark-bmenu-select] -- select bookmark of line point is on.
Also show bookmarks marked using m in other windows.
\\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names).
@@ -1762,20 +1760,46 @@ Bookmark names preceded by a \"*\" have annotations.
\\[bookmark-bmenu-relocate] -- relocate this bookmark's file (prompts for new file).
\\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
\\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
-\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'.
+\\[bookmark-bmenu-delete-all] -- mark all listed bookmarks as to be deleted.
+\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]' or `\\[bookmark-bmenu-delete-all]'.
\\[bookmark-bmenu-save] -- save the current bookmark list in the default file.
With a prefix arg, prompts for a file to save in.
\\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
\\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
With prefix argument, also move up one line.
\\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
+\\[bookmark-bmenu-unmark-all] -- remove all kinds of marks from all listed bookmarks.
\\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark
in another buffer.
\\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
\\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark.
\\[bookmark-bmenu-search] -- incrementally search for bookmarks."
(setq truncate-lines t)
- (setq buffer-read-only t))
+ (setq buffer-read-only t)
+ ;; FIXME: The header could also display the current default bookmark file
+ ;; according to `bookmark-bookmarks-timestamp'.
+ (setq tabulated-list-format
+ `[("" 1) ;; Space to add "*" for bookmark with annotation
+ ("Bookmark" ,bookmark-bmenu-file-column bookmark-bmenu--name-predicate)
+ ,@(if bookmark-bmenu-toggle-filenames
+ '(("File" 0 bookmark-bmenu--file-predicate)))])
+ (setq tabulated-list-padding bookmark-bmenu-marks-width)
+ (setq tabulated-list-sort-key '("Bookmark" . nil))
+ (add-hook 'tabulated-list-revert-hook #'bookmark-bmenu--revert nil t)'
+ (setq revert-buffer-function 'bookmark-bmenu--revert)
+ (tabulated-list-init-header))
+
+
+(defun bookmark-bmenu--name-predicate (a b)
+ "Predicate to sort \"*Bookmark List*\" buffer by the name column.
+This is used for `tabulated-list-format' in `bookmark-bmenu-mode'."
+ (string< (caar a) (caar b)))
+
+
+(defun bookmark-bmenu--file-predicate (a b)
+ "Predicate to sort \"*Bookmark List*\" buffer by the file column.
+This is used for `tabulated-list-format' in `bookmark-bmenu-mode'."
+ (string< (bookmark-location (car a)) (bookmark-location (car b))))
(defun bookmark-bmenu-toggle-filenames (&optional show)
@@ -1784,100 +1808,42 @@ Optional argument SHOW means show them unconditionally."
(interactive)
(cond
(show
- (setq bookmark-bmenu-toggle-filenames nil)
- (bookmark-bmenu-show-filenames)
(setq bookmark-bmenu-toggle-filenames t))
(bookmark-bmenu-toggle-filenames
- (bookmark-bmenu-hide-filenames)
(setq bookmark-bmenu-toggle-filenames nil))
(t
- (bookmark-bmenu-show-filenames)
(setq bookmark-bmenu-toggle-filenames t)))
- (when bookmark-bmenu-use-header-line
- (bookmark-bmenu-set-header)))
-
-
-(defun bookmark-bmenu-show-filenames (&optional force)
- "In an interactive bookmark list, show filenames along with bookmarks.
-Non-nil FORCE forces a redisplay showing the filenames. FORCE is used
-mainly for debugging, and should not be necessary in normal use."
- (if (and (not force) bookmark-bmenu-toggle-filenames)
- nil ;already shown, so do nothing
- (with-buffer-modified-unmodified
- (save-excursion
- (save-window-excursion
- (goto-char (point-min))
- (if (not bookmark-bmenu-use-header-line)
- (forward-line bookmark-bmenu-inline-header-height))
- (setq bookmark-bmenu-hidden-bookmarks ())
- (let ((inhibit-read-only t))
- (while (< (point) (point-max))
- (let ((bmrk (bookmark-bmenu-bookmark)))
- (push bmrk bookmark-bmenu-hidden-bookmarks)
- (let ((start (line-end-position)))
- (move-to-column bookmark-bmenu-file-column t)
- ;; Strip off `mouse-face' from the white spaces region.
- (if (display-mouse-p)
- (remove-text-properties start (point)
- '(mouse-face nil help-echo nil))))
- (delete-region (point) (progn (end-of-line) (point)))
- (insert " ")
- ;; Pass the NO-HISTORY arg:
- (bookmark-insert-location bmrk t)
- (forward-line 1)))))))))
-
-
-(defun bookmark-bmenu-hide-filenames (&optional force)
- "In an interactive bookmark list, hide the filenames of the bookmarks.
-Non-nil FORCE forces a redisplay showing the filenames. FORCE is used
-mainly for debugging, and should not be necessary in normal use."
- (when (and (not force) bookmark-bmenu-toggle-filenames)
- ;; nothing to hide if above is nil
- (with-buffer-modified-unmodified
- (save-excursion
- (goto-char (point-min))
- (if (not bookmark-bmenu-use-header-line)
- (forward-line bookmark-bmenu-inline-header-height))
- (setq bookmark-bmenu-hidden-bookmarks
- (nreverse bookmark-bmenu-hidden-bookmarks))
- (let ((inhibit-read-only t))
- (while bookmark-bmenu-hidden-bookmarks
- (move-to-column bookmark-bmenu-marks-width t)
- (bookmark-kill-line)
- (let ((name (pop bookmark-bmenu-hidden-bookmarks))
- (start (point)))
- (insert name)
- (put-text-property start (point) 'bookmark-name-prop name)
- (if (display-mouse-p)
- (add-text-properties
- start (point)
- '(font-lock-face bookmark-menu-bookmark
- mouse-face highlight
- follow-link t help-echo
- "mouse-2: go to this bookmark in other window"))))
- (forward-line 1)))))))
+ (bookmark-bmenu-surreptitiously-rebuild-list))
+
+
+(defun bookmark-bmenu-show-filenames (&optional _)
+ "In an interactive bookmark list, show filenames along with bookmarks."
+ (setq bookmark-bmenu-toggle-filenames t)
+ (bookmark-bmenu-surreptitiously-rebuild-list))
+
+
+(defun bookmark-bmenu-hide-filenames (&optional _)
+ "In an interactive bookmark list, hide the filenames of the bookmarks."
+ (setq bookmark-bmenu-toggle-filenames nil)
+ (bookmark-bmenu-surreptitiously-rebuild-list))
(defun bookmark-bmenu-ensure-position ()
"If point is not on a bookmark line, move it to one.
-If before the first bookmark line, move to the first; if after the
-last full line, move to the last full line. The return value is undefined."
- (cond ((and (not bookmark-bmenu-use-header-line)
- (< (count-lines (point-min) (point))
- bookmark-bmenu-inline-header-height))
- (goto-char (point-min))
- (forward-line bookmark-bmenu-inline-header-height))
- ((and (bolp) (eobp))
+If after the last full line, move to the last full line. The
+return value is undefined."
+ (cond ((and (bolp) (eobp))
(beginning-of-line 0))))
(defun bookmark-bmenu-bookmark ()
"Return the bookmark for this line in an interactive bookmark list buffer."
(bookmark-bmenu-ensure-position)
- (save-excursion
- (beginning-of-line)
- (forward-char bookmark-bmenu-marks-width)
- (get-text-property (point) 'bookmark-name-prop)))
+ (let* ((id (tabulated-list-get-id))
+ (entry (and id (assoc id tabulated-list-entries))))
+ (if entry
+ (caar entry)
+ "")))
(defun bookmark-show-annotation (bookmark-name-or-record)
@@ -1925,19 +1891,23 @@ If the annotation does not exist, do nothing."
(defun bookmark-bmenu-mark ()
"Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
(interactive)
- (beginning-of-line)
(bookmark-bmenu-ensure-position)
- (with-buffer-modified-unmodified
- (let ((inhibit-read-only t))
- (delete-char 1)
- (insert ?>)
- (forward-line 1)
- (bookmark-bmenu-ensure-position))))
+ (tabulated-list-put-tag ">" t))
+
+
+(defun bookmark-bmenu-mark-all ()
+ "Mark all listed bookmarks to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (while (not (eobp))
+ (tabulated-list-put-tag ">" t))))
(defun bookmark-bmenu-select ()
"Select this line's bookmark; also display bookmarks marked with `>'.
-You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] command."
+You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] or \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark-all] commands."
(interactive)
(let ((bmrk (bookmark-bmenu-bookmark))
(menu (current-buffer))
@@ -2083,17 +2053,12 @@ bookmark menu visible."
"Cancel all requested operations on bookmark on this line and move down.
Optional BACKUP means move up."
(interactive "P")
- (beginning-of-line)
+ ;; any flags to reset according to circumstances? How about a
+ ;; flag indicating whether this bookmark is being visited?
+ ;; well, we don't have this now, so maybe later.
(bookmark-bmenu-ensure-position)
- (with-buffer-modified-unmodified
- (let ((inhibit-read-only t))
- (delete-char 1)
- ;; any flags to reset according to circumstances? How about a
- ;; flag indicating whether this bookmark is being visited?
- ;; well, we don't have this now, so maybe later.
- (insert " "))
- (forward-line (if backup -1 1))
- (bookmark-bmenu-ensure-position)))
+ (tabulated-list-put-tag " ")
+ (forward-line (if backup -1 1)))
(defun bookmark-bmenu-backup-unmark ()
@@ -2106,18 +2071,22 @@ Optional BACKUP means move up."
(bookmark-bmenu-ensure-position))
+(defun bookmark-bmenu-unmark-all ()
+ "Cancel all requested operations on all listed bookmarks."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (while (not (eobp))
+ (tabulated-list-put-tag " " t))))
+
+
(defun bookmark-bmenu-delete ()
"Mark bookmark on this line to be deleted.
To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
(interactive)
- (beginning-of-line)
(bookmark-bmenu-ensure-position)
- (with-buffer-modified-unmodified
- (let ((inhibit-read-only t))
- (delete-char 1)
- (insert ?D)
- (forward-line 1)
- (bookmark-bmenu-ensure-position))))
+ (tabulated-list-put-tag "D" t))
(defun bookmark-bmenu-delete-backwards ()
@@ -2125,10 +2094,19 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
(interactive)
(bookmark-bmenu-delete)
- (forward-line -2)
- (bookmark-bmenu-ensure-position)
- (forward-line 1)
- (bookmark-bmenu-ensure-position))
+ (forward-line -2))
+
+
+(defun bookmark-bmenu-delete-all ()
+ "Mark all listed bookmarks as to be deleted.
+To remove all deletion marks, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-unmark-all].
+To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (bookmark-bmenu-ensure-position)
+ (while (not (eobp))
+ (tabulated-list-put-tag "D" t))))
(defun bookmark-bmenu-execute-deletions ()
@@ -2144,8 +2122,6 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(progn (end-of-line) (point))))))
(o-col (current-column)))
(goto-char (point-min))
- (unless bookmark-bmenu-use-header-line
- (forward-line 1))
(while (re-search-forward "^D" (point-max) t)
(bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg
(bookmark-bmenu-list)
@@ -2290,6 +2266,9 @@ strings returned are not."
(bindings--define-key map [delete]
'(menu-item "Delete Bookmark..." bookmark-delete
:help "Delete a bookmark from the bookmark list"))
+ (bindings--define-key map [delete-all]
+ '(menu-item "Delete all Bookmarks..." bookmark-delete-all
+ :help "Delete all bookmarks from the bookmark list"))
(bindings--define-key map [rename]
'(menu-item "Rename Bookmark..." bookmark-rename
:help "Change the name of a bookmark"))
@@ -2322,6 +2301,8 @@ strings returned are not."
;; Load Hook
(defvar bookmark-load-hook nil
"Hook run at the end of loading library `bookmark.el'.")
+(make-obsolete-variable 'bookmark-load-hook
+ "use `with-eval-after-load' instead." "28.1")
;; Exit Hook, called from kill-emacs-hook
(defvar bookmark-exit-hook nil
diff --git a/lisp/bs.el b/lisp/bs.el
index f5cb93b5169..337d22ecf83 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -173,7 +173,12 @@ return a string representing the column's value."
(defun bs--make-header-match-string ()
"Return a regexp matching the first line of a Buffer Selection Menu buffer."
- (concat "^\\(" (mapconcat #'car bs-attributes-list " *") " *$\\)"))
+ (concat "^\\("
+ (apply #'concat (mapcan (lambda (e)
+ (and (not (equal (car e) ""))
+ (list " *" (car e))))
+ bs-attributes-list))
+ " *$\\)"))
;; Font-Lock-Settings
(defvar bs-mode-font-lock-keywords
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 655a76a713c..d06ba287879 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -69,11 +69,26 @@ minus `Buffer-menu-size-width'. This use is deprecated."
"use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead."
"24.3")
-(defcustom Buffer-menu-name-width 19
- "Width of buffer name column in the Buffer Menu."
- :type 'number
+(defun Buffer-menu--dynamic-name-width (buffers)
+ "Return a name column width based on the current window width.
+The width will never exceed the actual width of the buffer names,
+but will never be narrower than 19 characters."
+ (max 19
+ ;; This gives 19 on an 80 column window, and take up
+ ;; proportionally more space as the window widens.
+ (min (truncate (/ (window-width) 4.2))
+ (apply #'max 0 (mapcar (lambda (b)
+ (length (buffer-name b)))
+ buffers)))))
+
+(defcustom Buffer-menu-name-width #'Buffer-menu--dynamic-name-width
+ "Width of buffer name column in the Buffer Menu.
+This can either be a number (used directly) or a function that
+will be called with the list of buffers and should return a
+number."
+ :type '(choice function number)
:group 'Buffer-menu
- :version "24.3")
+ :version "28.1")
(defcustom Buffer-menu-size-width 7
"Width of buffer size column in the Buffer Menu."
@@ -214,9 +229,6 @@ commands.")
map)
"Local keymap for `Buffer-menu-mode' buffers.")
-(define-obsolete-variable-alias 'buffer-menu-mode-hook
- 'Buffer-menu-mode-hook "23.1")
-
(define-derived-mode Buffer-menu-mode tabulated-list-mode "Buffer Menu"
"Major mode for Buffer Menu buffers.
The Buffer Menu is invoked by the commands \\[list-buffers],
@@ -488,8 +500,9 @@ Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted
(defun Buffer-menu-select ()
"Select this line's buffer; also, display buffers marked with `>'.
You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command.
+
This command deletes and replaces all the previously existing windows
-in the selected frame."
+in the selected frame, and will remove any marks."
(interactive)
(let* ((this-buffer (Buffer-menu-buffer t))
(menu-buffer (current-buffer))
@@ -645,25 +658,11 @@ means list those buffers and no others."
(defun list-buffers--refresh (&optional buffer-list old-buffer)
;; Set up `tabulated-list-format'.
- (let ((name-width Buffer-menu-name-width)
- (size-width Buffer-menu-size-width)
+ (let ((size-width Buffer-menu-size-width)
(marked-buffers (Buffer-menu-marked-buffers))
(buffer-menu-buffer (current-buffer))
(show-non-file (not Buffer-menu-files-only))
- entries)
- ;; Handle obsolete variable:
- (if Buffer-menu-buffer+size-width
- (setq name-width (- Buffer-menu-buffer+size-width size-width)))
- (setq tabulated-list-format
- (vector '("C" 1 t :pad-right 0)
- '("R" 1 t :pad-right 0)
- '("M" 1 t)
- `("Buffer" ,name-width t)
- `("Size" ,size-width tabulated-list-entry-size->
- :right-align t)
- `("Mode" ,Buffer-menu-mode-width t)
- '("File" 1 t)))
- (setq tabulated-list-use-header-line Buffer-menu-use-header-line)
+ entries name-width)
;; Collect info for each buffer we're interested in.
(dolist (buffer (or buffer-list
(buffer-list (if Buffer-menu-use-frame-buffer-list
@@ -693,6 +692,22 @@ means list those buffers and no others."
nil nil buffer)))
(Buffer-menu--pretty-file-name file)))
entries)))))
+ (setq name-width (if (functionp Buffer-menu-name-width)
+ (funcall Buffer-menu-name-width (mapcar #'car entries))
+ Buffer-menu-name-width))
+ ;; Handle obsolete variable:
+ (if Buffer-menu-buffer+size-width
+ (setq name-width (- Buffer-menu-buffer+size-width size-width)))
+ (setq tabulated-list-format
+ (vector '("C" 1 t :pad-right 0)
+ '("R" 1 t :pad-right 0)
+ '("M" 1 t)
+ `("Buffer" ,name-width t)
+ `("Size" ,size-width tabulated-list-entry-size->
+ :right-align t)
+ `("Mode" ,Buffer-menu-mode-width t)
+ '("File" 1 t)))
+ (setq tabulated-list-use-header-line Buffer-menu-use-header-line)
(setq tabulated-list-entries (nreverse entries)))
(tabulated-list-init-header))
diff --git a/lisp/button.el b/lisp/button.el
index b3afc4eca25..ba0682348df 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -78,6 +78,10 @@
"Keymap useful for buffers containing buttons.
Mode-specific keymaps may want to use this as their parent keymap.")
+(define-minor-mode button-mode
+ "A minor mode for navigating to buttons with the TAB key."
+ :keymap button-buffer-map)
+
;; Default properties for buttons.
(put 'default-button 'face 'button)
(put 'default-button 'mouse-face 'highlight)
@@ -341,15 +345,14 @@ If the property `button-data' is present, it will later be used
as the argument for the `action' callback function instead of the
default argument, which is the button itself.
-BEG can also be a string, in which case it is made into a button.
+BEG can also be a string, in which case a copy of it is made into
+a button and returned.
Also see `insert-text-button'."
(let ((object nil)
(type-entry
(or (plist-member properties 'type)
(plist-member properties :type))))
- (when (stringp beg)
- (setq object beg beg 0 end (length object)))
;; Disallow setting the `category' property directly.
(when (plist-get properties 'category)
(error "Button `category' property may not be set directly"))
@@ -362,6 +365,10 @@ Also see `insert-text-button'."
(setcar type-entry 'category)
(setcar (cdr type-entry)
(button-category-symbol (cadr type-entry))))
+ (when (stringp beg)
+ (setq object (copy-sequence beg))
+ (setq beg 0)
+ (setq end (length object)))
;; Now add all the text properties at once.
(add-text-properties beg end
;; Each button should have a non-eq `button'
@@ -461,18 +468,24 @@ see).
POS defaults to point, except when `push-button' is invoked
interactively as the result of a mouse-event, in which case, the
mouse event is used.
+
If there's no button at POS, do nothing and return nil, otherwise
-return t."
+return t.
+
+To get a description of what function will called when pushing a
+butting, use the `button-describe' command."
(interactive
(list (if (integerp last-command-event) (point) last-command-event)))
(if (and (not (integerp pos)) (eventp pos))
;; POS is a mouse event; switch to the proper window/buffer
(let ((posn (event-start pos)))
(with-current-buffer (window-buffer (posn-window posn))
- (if (posn-string posn)
- ;; mode-line, header-line, or display string event.
- (button-activate (posn-string posn) t)
- (push-button (posn-point posn) t))))
+ (let* ((str (posn-string posn))
+ (str-button (and str (get-text-property (cdr str) 'button (car str)))))
+ (if str-button
+ ;; mode-line, header-line, or display string event.
+ (button-activate str t)
+ (push-button (posn-point posn) t)))))
;; POS is just normal position
(let ((button (button-at (or pos (point)))))
(when button
@@ -480,12 +493,17 @@ return t."
t))))
(defun button--help-echo (button)
- "Evaluate BUTTON's `help-echo' property and return its value."
- (let ((help (button-get button 'help-echo)))
- (if (functionp help)
- (let ((obj (if (overlayp button) button (current-buffer))))
- (funcall help (selected-window) obj (button-start button)))
- (eval help lexical-binding))))
+ "Evaluate BUTTON's `help-echo' property and return its value.
+If the result is non-nil, pass it through `substitute-command-keys'
+before returning it, as is done for `show-help-function'."
+ (let* ((help (button-get button 'help-echo))
+ (help (if (functionp help)
+ (funcall help
+ (selected-window)
+ (if (overlayp button) button (current-buffer))
+ (button-start button))
+ (eval help lexical-binding))))
+ (and help (substitute-command-keys help))))
(defun forward-button (n &optional wrap display-message no-error)
"Move to the Nth next button, or Nth previous button if N is negative.
@@ -550,6 +568,51 @@ Returns the button found."
(interactive "p\nd\nd")
(forward-button (- n) wrap display-message no-error))
+(defun button--describe (properties)
+ "Describe a button's PROPERTIES (an alist) in a *Help* buffer.
+This is a helper function for `button-describe', in order to be possible to
+use `help-setup-xref'.
+
+Each element of PROPERTIES should be of the form (PROPERTY . VALUE)."
+ (help-setup-xref (list #'button--describe properties)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (with-current-buffer (help-buffer)
+ (insert (format-message "This button's type is `%s'."
+ (alist-get 'type properties)))
+ (dolist (prop '(action mouse-action))
+ (let ((name (symbol-name prop))
+ (val (alist-get prop properties)))
+ (when (functionp val)
+ (insert "\n\n"
+ (propertize (capitalize name) 'face 'bold)
+ "\nThe " name " of this button is")
+ (if (symbolp val)
+ (progn
+ (insert (format-message " `%s',\nwhich is " val))
+ (describe-function-1 val))
+ (insert "\n")
+ (princ val))))))))
+
+(defun button-describe (&optional button-or-pos)
+ "Display a buffer with information about the button at point.
+
+When called from Lisp, pass BUTTON-OR-POS as the button to describe, or a
+buffer position where a button is present. If BUTTON-OR-POS is nil, the
+button at point is the button to describe."
+ (interactive "d")
+ (let* ((button (cond ((integer-or-marker-p button-or-pos)
+ (button-at button-or-pos))
+ ((null button-or-pos) (button-at (point)))
+ ((overlayp button-or-pos) button-or-pos)))
+ (props (and button
+ (mapcar (lambda (prop)
+ (cons prop (button-get button prop)))
+ '(type action mouse-action)))))
+ (when props
+ (button--describe props)
+ t)))
+
(provide 'button)
;;; button.el ends here
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 55ce9711986..6c162b55f7b 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -1,4 +1,4 @@
-;;; calc-aent.el --- algebraic entry functions for Calc
+;;; calc-aent.el --- algebraic entry functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -158,7 +158,7 @@
(setq strp (cdr (cdr strp))))
(calc-do-calc-eval (car str) separator args)))
((eq separator 'eval)
- (eval str))
+ (eval str t))
((eq separator 'macro)
(require 'calc-ext)
(let* ((calc-buffer (current-buffer))
@@ -285,6 +285,8 @@ The value t means abort and give an error message.")
(defvar calc-alg-entry-history nil
"History for algebraic entry.")
+(defvar calc-plain-entry nil)
+
;;;###autoload
(defun calc-alg-entry (&optional initial prompt)
(let* ((calc-dollar-values (mapcar #'calc-get-stack-element
@@ -401,7 +403,6 @@ The value t means abort and give an error message.")
(use-local-map calc-mode-map))
(calcAlg-enter))
-(defvar calc-plain-entry nil)
(defun calcAlg-edit ()
(interactive)
(if (or (not calc-plain-entry)
@@ -576,8 +577,9 @@ in Calc algebraic input.")
(defvar math-expr-data)
;;;###autoload
-(defun math-read-exprs (math-exp-str)
- (let ((math-exp-pos 0)
+(defun math-read-exprs (str)
+ (let ((math-exp-str str)
+ (math-exp-pos 0)
(math-exp-old-pos 0)
(math-exp-keep-spaces nil)
math-exp-token math-expr-data)
@@ -738,8 +740,8 @@ in Calc algebraic input.")
math-exp-pos (match-end 0)))
((and (setq adfn
(assq ch (get calc-language 'math-lang-read-symbol)))
- (eval (nth 1 adfn)))
- (eval (nth 2 adfn)))
+ (eval (nth 1 adfn) t))
+ (eval (nth 2 adfn) t))
((eq ch ?\$)
(if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos)
math-exp-pos)
@@ -771,8 +773,8 @@ in Calc algebraic input.")
math-expr-data (math-match-substring math-exp-str 1)
math-exp-pos (match-end 0)))
((and (setq adfn (get calc-language 'math-lang-read))
- (eval (nth 0 adfn))
- (eval (nth 1 adfn))))
+ (eval (nth 0 adfn) t)
+ (eval (nth 1 adfn) t)))
((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos)
(setq math-exp-pos (match-end 0))
(math-read-token))
diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el
index b487aae6883..ae397c4f2c4 100644
--- a/lisp/calc/calc-arith.el
+++ b/lisp/calc/calc-arith.el
@@ -1,4 +1,4 @@
-;;; calc-arith.el --- arithmetic functions for Calc
+;;; calc-arith.el --- arithmetic functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -250,44 +250,43 @@
(while (setq p (cdr p))
(and (eq (car-safe (car p)) 'vec)
(setq vec (nth 2 (car p)))
- (condition-case err
- (let ((v (nth 1 (car p))))
- (setq type nil range nil)
- (or (eq (car-safe vec) 'vec)
- (setq vec (list 'vec vec)))
- (while (and (setq vec (cdr vec))
- (not (Math-objectp (car vec))))
- (and (eq (car-safe (car vec)) 'var)
- (let ((st (assq (nth 1 (car vec))
- math-super-types)))
- (cond (st (setq type (append type st)))
- ((eq (nth 1 (car vec)) 'pos)
- (setq type (append type
- '(real number))
- range
- '(intv 1 0 (var inf var-inf))))
- ((eq (nth 1 (car vec)) 'nonneg)
- (setq type (append type
- '(real number))
- range
- '(intv 3 0
- (var inf var-inf))))))))
- (if vec
- (setq type (append type '(real number))
- range (math-prepare-set (cons 'vec vec))))
- (setq type (list type range))
- (or (eq (car-safe v) 'vec)
- (setq v (list 'vec v)))
- (while (setq v (cdr v))
- (if (or (eq (car-safe (car v)) 'var)
- (not (Math-primp (car v))))
- (setq math-decls-cache
- (cons (cons (if (eq (car (car v)) 'var)
- (nth 2 (car v))
- (car (car v)))
- type)
- math-decls-cache)))))
- (error nil)))))
+ (ignore-errors
+ (let ((v (nth 1 (car p))))
+ (setq type nil range nil)
+ (or (eq (car-safe vec) 'vec)
+ (setq vec (list 'vec vec)))
+ (while (and (setq vec (cdr vec))
+ (not (Math-objectp (car vec))))
+ (and (eq (car-safe (car vec)) 'var)
+ (let ((st (assq (nth 1 (car vec))
+ math-super-types)))
+ (cond (st (setq type (append type st)))
+ ((eq (nth 1 (car vec)) 'pos)
+ (setq type (append type
+ '(real number))
+ range
+ '(intv 1 0 (var inf var-inf))))
+ ((eq (nth 1 (car vec)) 'nonneg)
+ (setq type (append type
+ '(real number))
+ range
+ '(intv 3 0
+ (var inf var-inf))))))))
+ (if vec
+ (setq type (append type '(real number))
+ range (math-prepare-set (cons 'vec vec))))
+ (setq type (list type range))
+ (or (eq (car-safe v) 'vec)
+ (setq v (list 'vec v)))
+ (while (setq v (cdr v))
+ (if (or (eq (car-safe (car v)) 'var)
+ (not (Math-primp (car v))))
+ (setq math-decls-cache
+ (cons (cons (if (eq (car (car v)) 'var)
+ (nth 2 (car v))
+ (car (car v)))
+ type)
+ math-decls-cache)))))))))
(setq math-decls-all (assq 'var-All math-decls-cache)))))
(defun math-known-scalarp (a &optional assume-scalar)
@@ -2892,7 +2891,7 @@
(eq a b))
(list 'calcFunc-exp sumpow))
(t
- (condition-case err
+ (condition-case nil
(math-pow a sumpow)
(inexact-result (list '^ a sumpow)))))))))
(and math-simplifying-units
@@ -2927,7 +2926,7 @@
(math-div 1 (list 'calcFunc-sqrt (math-mul a b))))
(t
(setq a (math-mul a b))
- (condition-case err
+ (condition-case nil
(math-pow a apow)
(inexact-result (list '^ a apow)))))))))))
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index e9083b84c61..60dd17e5ed2 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -1,4 +1,4 @@
-;;; calc-bin.el --- binary functions for Calc
+;;; calc-bin.el --- binary functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -126,8 +126,8 @@
(defun calc-word-size (n)
(interactive "P")
(calc-wrapper
- (or n (setq n (read-string (format "Binary word size: (default %d) "
- calc-word-size))))
+ (or n (setq n (read-string (format-prompt "Binary word size"
+ calc-word-size))))
(setq n (if (stringp n)
(if (equal n "")
calc-word-size
@@ -145,9 +145,10 @@
(setq math-half-2-word-size (math-power-of-2 (1- (math-abs n))))
(calc-do-refresh)
(calc-refresh-evaltos)
- (if (< n 0)
- (message "Binary word size is %d bits (two's complement)" (- n))
- (message "Binary word size is %d bits" n))))
+ (cond
+ ((< n 0) (message "Binary word size is %d bits (two's complement)" (- n)))
+ ((> n 0) (message "Binary word size is %d bits" n))
+ (t (message "No fixed binary word size")))))
@@ -262,9 +263,10 @@
(defun math-binary-arg (a w)
(if (not (Math-integerp a))
(setq a (math-trunc a)))
- (if (< a 0)
- (logand a (1- (ash 1 (if w (math-trunc w) calc-word-size))))
- a))
+ (let ((w (if w (math-trunc w) calc-word-size)))
+ (if (and (< a 0) (not (zerop w)))
+ (logand a (1- (ash 1 w)))
+ a)))
(defun math-binary-modulo-args (f a b w)
(let (mod)
@@ -285,7 +287,7 @@
(let ((bits (math-integer-log2 mod)))
(if bits
(if w
- (if (/= w bits)
+ (if (and (/= w bits) (not (zerop w)))
(calc-record-why
"*Warning: Modulus inconsistent with word size"))
(setq w bits))
@@ -371,11 +373,12 @@
(math-clip (calcFunc-lsh a n (- w)) w)
(if (Math-integer-negp a)
(setq a (math-clip a w)))
- (cond ((or (Math-lessp n (- w))
- (Math-lessp w n))
+ (cond ((and (or (Math-lessp n (- w))
+ (Math-lessp w n))
+ (not (zerop w)))
0)
((< n 0)
- (math-quotient (math-clip a w) (math-power-of-2 (- n))))
+ (ash (math-clip a w) n))
(t
(math-clip (math-mul a (math-power-of-2 n)) w))))))
@@ -403,7 +406,8 @@
(setq a (math-clip a w)))
(let ((two-to-sizem1 (math-power-of-2 (1- w)))
(sh (calcFunc-lsh a n w)))
- (cond ((Math-natnum-lessp a two-to-sizem1)
+ (cond ((or (zerop w)
+ (zerop (logand a two-to-sizem1)))
sh)
((Math-lessp n (- 1 w))
(math-add (math-mul two-to-sizem1 2) -1))
@@ -421,6 +425,8 @@
(if (eq (car-safe a) 'mod)
(math-binary-modulo-args 'calcFunc-rot a n w)
(setq w (if w (math-trunc w) calc-word-size))
+ (when (zerop w)
+ (error "Rotation requires a nonzero word size"))
(or (integerp w)
(math-reject-arg w 'fixnump))
(or (Math-integerp a)
@@ -452,6 +458,8 @@
(if (Math-natnum-lessp a (math-power-of-2 (- -1 w)))
a
(math-sub a (math-power-of-2 (- w)))))
+ ((math-zerop w)
+ a)
((Math-negp a)
(math-binary-arg a w))
((integerp a)
@@ -682,6 +690,8 @@
(defun math-format-twos-complement (a)
"Format an integer in two's complement mode."
+ (when (zerop calc-word-size)
+ (error "Nonzero word size required"))
(let* (;(calc-leading-zeros t)
(num
(cond
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index d4562a0cc86..5aeb8cba0df 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -1,4 +1,4 @@
-;;; calc-comb.el --- combinatoric functions for Calc
+;;; calc-comb.el --- combinatoric functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -241,8 +241,8 @@
(calcFunc-gcd (math-neg a) b))
((Math-looks-negp b)
(calcFunc-gcd a (math-neg b)))
- ((Math-zerop a) b)
- ((Math-zerop b) a)
+ ((Math-zerop a) (math-abs b))
+ ((Math-zerop b) (math-abs a))
((and (Math-ratp a)
(Math-ratp b))
(math-make-frac (math-gcd (if (eq (car-safe a) 'frac) (nth 1 a) a)
@@ -292,15 +292,9 @@
(defconst math-small-factorial-table
(vector 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800
- (math-read-number-simple "479001600")
- (math-read-number-simple "6227020800")
- (math-read-number-simple "87178291200")
- (math-read-number-simple "1307674368000")
- (math-read-number-simple "20922789888000")
- (math-read-number-simple "355687428096000")
- (math-read-number-simple "6402373705728000")
- (math-read-number-simple "121645100408832000")
- (math-read-number-simple "2432902008176640000")))
+ 479001600 6227020800 87178291200 1307674368000 20922789888000
+ 355687428096000 6402373705728000 121645100408832000
+ 2432902008176640000))
(defun calcFunc-fact (n) ; [I I] [F F] [Public]
(let (temp)
@@ -445,12 +439,25 @@
(math-div (calcFunc-fact (math-float n))
(math-mul (calcFunc-fact m)
(calcFunc-fact (math-sub n m))))))
- ((math-negp m) 0)
- ((math-negp n)
- (let ((val (calcFunc-choose (math-add (math-add n m) -1) m)))
+ ;; For the extension to negative integer arguments we follow
+ ;; M. J. Kronenburg, The Binomial Coefficient for Negative Arguments,
+ ;; arXiv:1105.3689v2
+ ((and (math-negp n) (not (math-negp m)))
+ ;; n<0≤m: (n choose m) = (-1)^m (-n+m-1 choose m)
+ (let ((val (calcFunc-choose (math-add (math-sub m n) -1) m)))
(if (math-evenp (math-trunc m))
val
(math-neg val))))
+ ((and (math-negp n) (math-num-integerp n))
+ (if (math-lessp n m)
+ 0
+ ;; m≤n<0: (n choose m) = (-1)^(n-m) (-m-1 choose n-m)
+ (let ((val (calcFunc-choose (math-sub (math-neg m) 1)
+ (math-sub n m))))
+ (if (math-evenp (math-sub n m))
+ val
+ (math-neg val)))))
+ ((math-negp m) 0)
((and (math-num-integerp n)
(Math-lessp n m))
0)
@@ -467,20 +474,23 @@
(math-choose-float-iter tm n 1 1)))))))
(defun math-choose-iter (m n i c)
- (if (and (= (% i 5) 1) (> i 5))
+ (while (<= i m)
+ (when (and (= (% i 5) 1) (> i 5))
(math-working (format "choose(%d)" (1- i)) c))
- (if (<= i m)
- (math-choose-iter m (1- n) (1+ i)
- (math-quotient (math-mul c n) i))
- c))
+ (setq c (math-quotient (math-mul c n) i))
+ (setq n (1- n))
+ (setq i (1+ i)))
+ c)
(defun math-choose-float-iter (count n i c)
- (if (= (% i 5) 1)
+ (while (> count 0)
+ (when (= (% i 5) 1)
(math-working (format "choose(%d)" (1- i)) c))
- (if (> count 0)
- (math-choose-float-iter (1- count) (math-sub n 1) (1+ i)
- (math-div (math-mul c n) i))
- c))
+ (setq c (math-div (math-mul c n) i))
+ (setq n (math-sub n 1))
+ (setq i (1+ i))
+ (setq count (1- count)))
+ c)
;;; Stirling numbers.
diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el
index f4324dcbf1e..7438f63a90d 100644
--- a/lisp/calc/calc-cplx.el
+++ b/lisp/calc/calc-cplx.el
@@ -1,4 +1,4 @@
-;;; calc-cplx.el --- Complex number functions for Calc
+;;; calc-cplx.el --- Complex number functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index 220213e0fbb..f9c5281c263 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -1,4 +1,4 @@
-;;; calc-embed.el --- embed Calc in a buffer
+;;; calc-embed.el --- embed Calc in a buffer -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -219,13 +219,17 @@
(defvar calc-override-minor-modes
(cons t calc-override-minor-modes-map))
-(defun calc-do-embedded (calc-embed-arg end obeg oend)
+(defvar calc-embedded-no-reselect nil)
+
+(defun calc-do-embedded (embed-arg end obeg oend)
+ (let ((calc-embed-arg embed-arg))
(if calc-embedded-info
;; Turn embedded mode off or switch to a new buffer.
(cond ((eq (current-buffer) (aref calc-embedded-info 1))
(let ((calcbuf (current-buffer))
- (buf (aref calc-embedded-info 0)))
+ ;; (buf (aref calc-embedded-info 0))
+ )
(calc-embedded-original-buffer t)
(calc-embedded nil)
(switch-to-buffer calcbuf)))
@@ -291,7 +295,7 @@
(calc-embedded-info info)
(calc-embedded-no-reselect t))
(calc-wrapper
- (let* ((okay nil)
+ (let* (;; (okay nil)
(calc-no-refresh-evaltos t))
(if (aref info 8)
(progn
@@ -336,7 +340,7 @@
"Type `C-x * x'"
"Give this command again")
" to return to normal")))))
- (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed.
+ (scroll-down 0))) ; fix a bug which occurs when truncate-lines is changed.
(defun calc-embedded-select (arg)
@@ -353,9 +357,10 @@
(calc-select-part 2)))
-(defun calc-embedded-update-formula (calc-embed-arg)
+(defun calc-embedded-update-formula (embed-arg)
(interactive "P")
- (if calc-embed-arg
+ (let ((calc-embed-arg embed-arg))
+ (if embed-arg
(let ((entry (assq (current-buffer) calc-embedded-active)))
(while (setq entry (cdr entry))
(and (eq (car-safe (aref (car entry) 8)) 'calcFunc-evalto)
@@ -376,12 +381,13 @@
(progn
(save-excursion
(calc-embedded-update info 14 'eval t))
- (goto-char (+ (aref info 4) pt))))))))
+ (goto-char (+ (aref info 4) pt)))))))))
-(defun calc-embedded-edit (calc-embed-arg)
+(defun calc-embedded-edit (embed-arg)
(interactive "P")
- (let ((info (calc-embedded-make-info (point) nil t calc-embed-arg))
+ (let ((calc-embed-arg embed-arg))
+ (let ((info (calc-embedded-make-info (point) nil t embed-arg))
str)
(if (eq (car-safe (aref info 8)) 'error)
(progn
@@ -392,15 +398,14 @@
(math-format-nice-expr (aref info 8) (frame-width))))
(calc-edit-mode (list 'calc-embedded-finish-edit info))
(insert str "\n")))
- (calc-show-edit-buffer))
+ (calc-show-edit-buffer)))
(defvar calc-original-buffer)
(defvar calc-edit-top)
(defun calc-embedded-finish-edit (info)
(let ((buf (current-buffer))
(str (buffer-substring calc-edit-top (point-max)))
- (start (point))
- pos)
+ (start (point))) ;; pos
(switch-to-buffer calc-original-buffer)
(let ((val (with-current-buffer (aref info 1)
(let ((calc-language nil)
@@ -416,7 +421,8 @@
(calc-embedded-update info 14 t t))))
;;;###autoload
-(defun calc-do-embedded-activate (calc-embed-arg cbuf)
+(defun calc-do-embedded-activate (embed-arg cbuf)
+ (let ((calc-embed-arg embed-arg))
(calc-plain-buffer-only)
(if calc-embed-arg
(calc-embedded-forget))
@@ -443,7 +449,7 @@
(or (eq (car-safe (aref info 8)) 'error)
(goto-char (aref info 5))))))
(message "Activating %s for Calc Embedded mode...done" (buffer-name)))
- (calc-embedded-active-state t))
+ (calc-embedded-active-state t)))
(defun calc-plain-buffer-only ()
(if (memq major-mode '(calc-mode calc-trail-mode calc-edit-mode))
@@ -735,13 +741,13 @@ The command \\[yank] can retrieve it from there."
(defun calc-find-globals ()
(interactive)
- (and (eq major-mode 'calc-mode)
+ (and (derived-mode-p 'calc-mode)
(error "This command should be used in a normal editing buffer"))
(make-local-variable 'calc-embedded-globals)
(let ((case-fold-search nil)
(modes nil)
(save-pt (point))
- found value)
+ found) ;; value
(goto-char (point-min))
(while (re-search-forward "\\[calc-global-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)\\]" nil t)
(and (setq found (assoc (buffer-substring (match-beginning 1)
@@ -764,7 +770,7 @@ The command \\[yank] can retrieve it from there."
(modes nil)
(emodes nil)
(pmodes nil)
- found value)
+ found) ;; value
(while (and no-defaults (search-backward "[calc-" nil t))
(forward-char 6)
(or (and (looking-at "mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
@@ -817,9 +823,13 @@ The command \\[yank] can retrieve it from there."
(defvar calc-embed-vars-used)
(defun calc-embedded-make-info (point cbuf fresh &optional
- calc-embed-top calc-embed-bot
- calc-embed-outer-top calc-embed-outer-bot)
- (let* ((bufentry (assq (current-buffer) calc-embedded-active))
+ embed-top embed-bot
+ embed-outer-top embed-outer-bot)
+ (let* ((calc-embed-top embed-top)
+ (calc-embed-bot embed-bot)
+ (calc-embed-outer-top embed-outer-top)
+ (calc-embed-outer-bot embed-outer-bot)
+ (bufentry (assq (current-buffer) calc-embedded-active))
(found bufentry)
(force (and fresh calc-embed-top (null (equal calc-embed-top '(t)))))
(fixed calc-embed-top)
@@ -1175,7 +1185,6 @@ The command \\[yank] can retrieve it from there."
;;; These are hooks called by the main part of Calc.
-(defvar calc-embedded-no-reselect nil)
(defun calc-embedded-select-buffer ()
(if (eq (current-buffer) (aref calc-embedded-info 0))
(let ((info calc-embedded-info)
@@ -1240,7 +1249,7 @@ The command \\[yank] can retrieve it from there."
(with-current-buffer (aref calc-embedded-info 1)
(let* ((info calc-embedded-info)
(extra-line (if (eq calc-language 'big) 1 0))
- (the-point (point))
+ ;; (the-point (point))
(empty (= (calc-stack-size) 0))
(entry (if empty
(list '(var empty var-empty) 1 nil)
@@ -1274,6 +1283,7 @@ The command \\[yank] can retrieve it from there."
(set-buffer-modified-p (buffer-modified-p)))))
(defun calc-embedded-modes-change (vars)
+ (defvar the-language) (defvar the-display-just)
(if (eq (car vars) 'calc-language) (setq vars '(the-language)))
(if (eq (car vars) 'calc-display-just) (setq vars '(the-display-just)))
(while (and vars
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 5c11554d5d7..23248ce1bd5 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1398,9 +1398,8 @@ calc-kill calc-kill-region calc-yank))))
(defun calc-scroll-up (n)
(interactive "P")
- (condition-case nil
- (scroll-up (or n (/ (window-height) 2)))
- (error nil))
+ (ignore-errors
+ (scroll-up (or n (/ (window-height) 2))))
(if (pos-visible-in-window-p (max 1 (- (point-max) 2)))
(if (eq major-mode 'calc-mode)
(calc-realign)
@@ -3095,6 +3094,7 @@ If X is not an error form, return 1."
(defvar math-read-big-baseline)
(defvar math-read-big-h2)
(defvar math-read-big-err-msg)
+(defvar math-read-big-lines)
(defun math-read-big-expr (str)
(and (> (length calc-left-label) 0)
@@ -3139,41 +3139,42 @@ If X is not an error form, return 1."
(defvar math-rb-h2)
-(defun math-read-big-bigp (math-read-big-lines)
- (and (cdr math-read-big-lines)
- (let ((matrix nil)
- (v 0)
- (height (if (> (length (car math-read-big-lines)) 0) 1 0)))
- (while (and (cdr math-read-big-lines)
- (let* ((i 0)
- j
- (l1 (car math-read-big-lines))
- (l2 (nth 1 math-read-big-lines))
- (len (min (length l1) (length l2))))
- (if (> (length l2) 0)
- (setq height (1+ height)))
- (while (and (< i len)
- (or (memq (aref l1 i) '(?\ ?\- ?\_))
- (memq (aref l2 i) '(?\ ?\-))
- (and (memq (aref l1 i) '(?\| ?\,))
- (= (aref l2 i) (aref l1 i)))
- (and (eq (aref l1 i) ?\[)
- (eq (aref l2 i) ?\[)
- (let ((math-rb-h2 (length l1)))
- (setq j (math-read-big-balance
- (1+ i) v "[")))
- (setq i (1- j)))))
- (setq i (1+ i)))
- (or (= i len)
- (and (eq (aref l1 i) ?\[)
- (eq (aref l2 i) ?\[)
- (setq matrix t)
- nil))))
- (setq math-read-big-lines (cdr math-read-big-lines)
- v (1+ v)))
- (or (and (> height 1)
- (not (cdr math-read-big-lines)))
- matrix))))
+(defun math-read-big-bigp (read-big-lines)
+ (when (cdr read-big-lines)
+ (let ((math-read-big-lines read-big-lines)
+ (matrix nil)
+ (v 0)
+ (height (if (> (length (car read-big-lines)) 0) 1 0)))
+ (while (and (cdr math-read-big-lines)
+ (let* ((i 0)
+ j
+ (l1 (car math-read-big-lines))
+ (l2 (nth 1 math-read-big-lines))
+ (len (min (length l1) (length l2))))
+ (if (> (length l2) 0)
+ (setq height (1+ height)))
+ (while (and (< i len)
+ (or (memq (aref l1 i) '(?\ ?\- ?\_))
+ (memq (aref l2 i) '(?\ ?\-))
+ (and (memq (aref l1 i) '(?\| ?\,))
+ (= (aref l2 i) (aref l1 i)))
+ (and (eq (aref l1 i) ?\[)
+ (eq (aref l2 i) ?\[)
+ (let ((math-rb-h2 (length l1)))
+ (setq j (math-read-big-balance
+ (1+ i) v "[")))
+ (setq i (1- j)))))
+ (setq i (1+ i)))
+ (or (= i len)
+ (and (eq (aref l1 i) ?\[)
+ (eq (aref l2 i) ?\[)
+ (setq matrix t)
+ nil))))
+ (setq math-read-big-lines (cdr math-read-big-lines)
+ v (1+ v)))
+ (or (and (> height 1)
+ (not (cdr math-read-big-lines)))
+ matrix))))
;;; Nontrivial "flat" formatting.
@@ -3457,6 +3458,8 @@ A command spec is a command name symbol, a keyboard macro string, a
list containing a numeric entry string, or nil.
A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.")
+(make-obsolete-variable 'calc-ext-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'calc-ext-load-hook)
(provide 'calc-ext)
diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el
index d1525939b11..ea1ef24bb19 100644
--- a/lisp/calc/calc-fin.el
+++ b/lisp/calc/calc-fin.el
@@ -1,4 +1,4 @@
-;;; calc-fin.el --- financial functions for Calc
+;;; calc-fin.el --- financial functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index 5a8f0a38d24..465d4520b05 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -1,4 +1,4 @@
-;;; calc-forms.el --- data format conversion functions for Calc
+;;; calc-forms.el --- data format conversion functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -678,10 +678,11 @@ in the Gregorian calendar."
(defvar math-fd-isoweek)
(defvar math-fd-isoweekday)
-(defun math-format-date (math-fd-date)
- (if (eq (car-safe math-fd-date) 'date)
- (setq math-fd-date (nth 1 math-fd-date)))
- (let ((entry (list math-fd-date calc-internal-prec calc-date-format)))
+(defun math-format-date (fd-date)
+ (let* ((math-fd-date (if (eq (car-safe fd-date) 'date)
+ (nth 1 fd-date)
+ fd-date))
+ (entry (list math-fd-date calc-internal-prec calc-date-format)))
(or (cdr (assoc entry math-format-date-cache))
(let* ((math-fd-dt nil)
(math-fd-iso-dt nil)
@@ -709,6 +710,10 @@ as measured in the number of days before December 31, 1 BC (Gregorian).")
"The beginning of the Julian date calendar,
as measured in the integer number of days before December 31, 1 BC (Gregorian).")
+(defconst math-unix-epoch 719163
+ "The beginning of Unix time: days from December 31, 1 BC (Gregorian)
+to Jan 1, 1970 AD.")
+
(defun math-format-date-part (x)
(cond ((stringp x)
x)
@@ -730,7 +735,8 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
(math-floor math-fd-date)
math-julian-date-beginning-int)))
((eq x 'U)
- (math-format-number (nth 1 (math-date-parts math-fd-date 719164))))
+ (math-format-number (nth 1 (math-date-parts math-fd-date
+ math-unix-epoch))))
((memq x '(IYYY Iww w))
(progn
(or math-fd-iso-dt
@@ -909,15 +915,16 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
;; which is called by math-parse-date and math-parse-standard-date.
(defvar math-pd-str)
-(defun math-parse-date (math-pd-str)
+(defun math-parse-date (pd-str)
(catch 'syntax
- (or (math-parse-standard-date math-pd-str t)
- (math-parse-standard-date math-pd-str nil)
- (and (string-match "W[0-9][0-9]" math-pd-str)
- (math-parse-iso-date math-pd-str))
- (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" math-pd-str)
- (list 'date (math-read-number (math-match-substring math-pd-str 1))))
+ (or (math-parse-standard-date pd-str t)
+ (math-parse-standard-date pd-str nil)
+ (and (string-match "W[0-9][0-9]" pd-str)
+ (math-parse-iso-date pd-str))
+ (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" pd-str)
+ (list 'date (math-read-number (math-match-substring pd-str 1))))
(let ((case-fold-search t)
+ (math-pd-str pd-str)
(year nil) (month nil) (day nil) (weekday nil)
(hour nil) (minute nil) (second nil) (bc-flag nil)
(a nil) (b nil) (c nil) (bigyear nil) temp)
@@ -1123,8 +1130,9 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
(substring math-pd-str (match-end 0))))
n))))
-(defun math-parse-standard-date (math-pd-str with-time)
- (let ((case-fold-search t)
+(defun math-parse-standard-date (pd-str with-time)
+ (let ((math-pd-str pd-str)
+ (case-fold-search t)
(okay t) num
(fmt calc-date-format) this next (gnext nil)
(isoyear nil) (isoweek nil) (isoweekday nil)
@@ -1173,7 +1181,7 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
(setq num (math-match-substring math-pd-str 0)
math-pd-str (substring math-pd-str (match-end 0))
num (math-date-to-dt
- (math-add 719164
+ (math-add math-unix-epoch
(math-div (math-read-number num)
'(float 864 2))))
hour (nth 3 num)
@@ -1301,9 +1309,10 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
(setq day (math-add day (1- yearday))))
day))))))
-(defun math-parse-iso-date (math-pd-str)
- "Parse MATH-PD-STR as an ISO week date, or return nil."
- (let ((case-fold-search t)
+(defun math-parse-iso-date (pd-str)
+ "Parse PD-STR as an ISO week date, or return nil."
+ (let ((math-pd-str pd-str)
+ (case-fold-search t)
(isoyear nil) (isoweek nil) (isoweekday nil)
(hour nil) (minute nil) (second nil))
;; Extract the time, if any.
@@ -1434,11 +1443,11 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
(defun calcFunc-unixtime (date &optional zone)
(if (math-realp date)
(progn
- (setq date (math-add 719163 (math-div date '(float 864 2))))
+ (setq date (math-add math-unix-epoch (math-div date '(float 864 2))))
(list 'date (math-sub date (math-div (calcFunc-tzone zone date)
'(float 864 2)))))
(if (eq (car date) 'date)
- (math-add (nth 1 (math-date-parts (nth 1 date) 719163))
+ (math-add (nth 1 (math-date-parts (nth 1 date) math-unix-epoch))
(calcFunc-tzone zone date))
(math-reject-arg date 'datep))))
@@ -1608,7 +1617,7 @@ and ends on the first Sunday of November at 2 a.m."
(math-std-daylight-savings-old date dt zone bump)
(math-std-daylight-savings-new date dt zone bump)))
-(defun math-std-daylight-savings-new (date dt zone bump)
+(defun math-std-daylight-savings-new (date dt _zone bump)
"Standard North American daylight saving algorithm as of 2007.
This implements the rules for the U.S. and Canada.
Daylight saving begins on the second Sunday of March at 2 a.m.,
@@ -1629,7 +1638,7 @@ and ends on the first Sunday of November at 2 a.m."
(t 0))))
(t 0)))
-(defun math-std-daylight-savings-old (date dt zone bump)
+(defun math-std-daylight-savings-old (date dt _zone bump)
"Standard North American daylight saving algorithm before 2007.
This implements the rules for the U.S. and Canada.
Daylight saving begins on the first Sunday of April at 2 a.m.,
@@ -1652,7 +1661,7 @@ and ends on the last Sunday of October at 2 a.m."
;;; Compute the day (1-31) of the WDAY (0-6) on or preceding the given
;;; day of the given month.
-(defun math-prev-weekday-in-month (date dt day wday)
+(defun math-prev-weekday-in-month (date dt day _wday)
(or day (setq day (nth 2 dt)))
(if (> day (math-days-in-month (car dt) (nth 1 dt)))
(setq day (math-days-in-month (car dt) (nth 1 dt))))
@@ -1870,8 +1879,8 @@ and ends on the last Sunday of October at 2 a.m."
(and days (= day (car days))
(setq holiday t)))
(let* ((weekdays (nth 3 math-holidays-cache))
- (weeks (1- (/ (+ day 6) 7)))
- (wkday (- day 1 (* weeks 7))))
+ (weeks (/ day 7))
+ (wkday (mod day 7))) ; Day of week: 0=Sunday, 6=Saturday
(setq delta (+ delta (* weeks (length weekdays))))
(while (and weekdays (< (car weekdays) wkday))
(setq weekdays (cdr weekdays)
@@ -1905,14 +1914,15 @@ and ends on the last Sunday of October at 2 a.m."
(setq delta (1+ delta)))
(setq day (+ day delta)))
(let* ((weekdays (nth 3 math-holidays-cache))
- (bweek (- 7 (length weekdays)))
- (weeks (1- (/ (+ day (1- bweek)) bweek)))
- (wkday (- day 1 (* weeks bweek)))
+ (bweek (- 7 (length weekdays))) ; Business days in a week, 1..7.
+ (weeks (/ day bweek)) ; Whole weeks.
+ (wkday (mod day bweek)) ; Business day in last week, 0..bweek-1
(w 0))
(setq day (+ day (* weeks (length weekdays))))
+ ;; Add business days in the last week; `w' is weekday, 0..6.
(while (if (memq w weekdays)
(setq day (1+ day))
- (> (setq wkday (1- wkday)) 0))
+ (>= (setq wkday (1- wkday)) 0))
(setq w (1+ w)))
(let ((hours (nth 7 math-holidays-cache)))
(if hours
@@ -2030,18 +2040,18 @@ and ends on the last Sunday of October at 2 a.m."
nil)))
(or done (setq math-holidays-cache-tag t))))))
-(defun math-setup-year-holidays (math-sh-year)
- (let ((exprs (nth 2 math-holidays-cache)))
- (while exprs
+(defun math-setup-year-holidays (sh-year)
+ (let ((math-sh-year sh-year))
+ (dolist (expr (nth 2 math-holidays-cache))
+ (defvar var-y) (defvar var-m)
(let* ((var-y math-sh-year)
(var-m nil)
- (expr (math-evaluate-expr (car exprs))))
+ (expr (math-evaluate-expr expr)))
(if (math-expr-contains expr '(var m var-m))
(let ((var-m 0))
(while (<= (setq var-m (1+ var-m)) 12)
(math-setup-add-holidays (math-evaluate-expr expr))))
- (math-setup-add-holidays expr)))
- (setq exprs (cdr exprs)))))
+ (math-setup-add-holidays expr))))))
(defun math-setup-add-holidays (days) ; uses "math-sh-year"
(cond ((eq (car-safe days) 'vec)
diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el
index 33c1fbaab8d..86a4808c5ad 100644
--- a/lisp/calc/calc-frac.el
+++ b/lisp/calc/calc-frac.el
@@ -1,4 +1,4 @@
-;;; calc-frac.el --- fraction functions for Calc
+;;; calc-frac.el --- fraction functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index add39b6f8b9..5c179ff05d4 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -1,4 +1,4 @@
-;;; calc-funcs.el --- well-known functions for Calc
+;;; calc-funcs.el --- well-known functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -816,25 +816,25 @@
(list
(list 'frac
-174611
- (math-read-number-simple "802857662698291200000"))
+ 802857662698291200000)
(list 'frac
43867
- (math-read-number-simple "5109094217170944000"))
+ 5109094217170944000)
(list 'frac
-3617
- (math-read-number-simple "10670622842880000"))
+ 10670622842880000)
(list 'frac
1
- (math-read-number-simple "74724249600"))
+ 74724249600)
(list 'frac
-691
- (math-read-number-simple "1307674368000"))
+ 1307674368000)
(list 'frac
1
- (math-read-number-simple "47900160"))
+ 47900160)
(list 'frac
-1
- (math-read-number-simple "1209600"))
+ 1209600)
(list 'frac
1
30240)
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 4cdfdbd4b92..829fa44ca4f 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1,4 +1,4 @@
-;;; calc-graph.el --- graph output functions for Calc
+;;; calc-graph.el --- graph output functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -216,7 +216,7 @@
(or (and (Math-num-integerp pstyle) (math-trunc pstyle))
(if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec)
0 -1))
- (math-contains-sdev-p (eval (nth 2 ydata))))))
+ (math-contains-sdev-p (eval (nth 2 ydata) t)))))
(defun calc-graph-lookup (thing)
(if (and (eq (car-safe thing) 'var)
@@ -313,13 +313,13 @@
(defvar calc-graph-blank)
(defvar calc-graph-non-blank)
(defvar calc-graph-curve-num)
+(defvar math-arglist)
(defun calc-graph-plot (flag &optional printing)
(interactive "P")
(calc-slow-wrapper
(let ((calcbuf (current-buffer))
(tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
- (tempbuftop 1)
(tempoutfile nil)
(calc-graph-curve-num 0)
(calc-graph-refine (and flag (> (prefix-numeric-value flag) 0)))
@@ -403,7 +403,7 @@
(and (equal output "tty") (setq tty-output t)))
(setq tempoutfile (calc-temp-file-name -1)
output tempoutfile))
- (setq output (eval output)))
+ (setq output (eval output t)))
(or (equal device calc-graph-last-device)
(progn
(setq calc-graph-last-device device)
@@ -480,9 +480,11 @@
(calc-graph-xp calc-graph-xvalue)
(calc-graph-yp calc-graph-yvalue)
(calc-graph-zp nil)
- (calc-graph-xlow nil) (calc-graph-xhigh nil) (y3low nil) (y3high nil)
+ (calc-graph-xlow nil) (calc-graph-xhigh nil)
+ ;; (y3low nil) (y3high nil)
calc-graph-xvec calc-graph-xval calc-graph-xstep var-DUMMY
- y3val calc-graph-y3step var-DUMMY2 (calc-graph-zval nil)
+ ;; y3val
+ calc-graph-y3step var-DUMMY2 (calc-graph-zval nil)
calc-graph-yvec calc-graph-yval calc-graph-ycache calc-graph-ycacheptr calc-graph-yvector
calc-graph-numsteps calc-graph-numsteps3
(calc-graph-keep-file (and (not calc-graph-is-splot) (file-exists-p filename)))
@@ -562,7 +564,7 @@
calc-gnuplot-print-output)))
(if (symbolp command)
(funcall command output)
- (eval command))))))))))
+ (eval command t))))))))))
(defun calc-graph-compute-2d ()
(if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec))
@@ -905,16 +907,15 @@
(while calc-graph-file-cache
(and (car calc-graph-file-cache)
(file-exists-p (car (car calc-graph-file-cache)))
- (condition-case err
- (delete-file (car (car calc-graph-file-cache)))
- (error nil)))
+ (ignore-errors
+ (delete-file (car (car calc-graph-file-cache)))))
(setq calc-graph-file-cache (cdr calc-graph-file-cache))))
(defun calc-graph-kill-hook ()
(calc-graph-delete-temps))
(defun calc-graph-show-tty (output)
- "Default calc-gnuplot-plot-command for \"tty\" output mode.
+ "Default `calc-gnuplot-plot-command' for \"tty\" output mode.
This is useful for tek40xx and other graphics-terminal types."
(call-process shell-file-name nil calc-gnuplot-buffer nil
shell-command-switch
@@ -923,7 +924,7 @@ This is useful for tek40xx and other graphics-terminal types."
(defvar calc-dumb-map nil
"The keymap for the \"dumb\" terminal plot.")
-(defun calc-graph-show-dumb (&optional output)
+(defun calc-graph-show-dumb (&optional _output)
"Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type.
This \"dumb\" driver will be present in Gnuplot 3.0."
(interactive)
@@ -1116,14 +1117,14 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(delete-region start end)
(goto-char start)
(setq errform
- (condition-case nil
- (math-contains-sdev-p
- (eval (intern
- (concat "var-"
- (save-excursion
- (re-search-backward ":\\(.*\\)}")
- (match-string 1))))))
- (error nil)))
+ (ignore-errors
+ (math-contains-sdev-p
+ (symbol-value
+ (intern
+ (concat "var-"
+ (save-excursion
+ (re-search-backward ":\\(.*\\)}")
+ (match-string 1))))))))
(if yerr
(insert " with yerrorbars")
(insert " with "
@@ -1165,7 +1166,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(or (calc-graph-find-plot nil nil)
(error "No data points have been set!"))
(let ((base (point))
- start
+ ;; start
end)
(re-search-forward "[,\n]\\|[ \t]+with")
(setq end (match-beginning 0))
@@ -1462,7 +1463,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(match-beginning 1)
(match-end 1))))
(setq calc-gnuplot-version 1))))
- (condition-case err
+ (condition-case nil
(let ((args (append (and calc-gnuplot-display
(not (equal calc-gnuplot-display
(getenv "DISPLAY")))
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index 72cf90a7587..0b327e8d0f6 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -1,4 +1,4 @@
-;;; calc-help.el --- help display functions for Calc,
+;;; calc-help.el --- help display functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -33,8 +33,8 @@
(declare-function Info-last "info" ())
-(defun calc-help-prefix (arg)
- "This key is the prefix for Calc help functions. See calc-help-for-help."
+(defun calc-help-prefix (&optional _arg)
+ "This key is the prefix for Calc help functions. See `calc-help-for-help'."
(interactive "P")
(or calc-dispatch-help (sit-for echo-keystrokes))
(let ((key (calc-read-key-sequence
@@ -79,7 +79,7 @@ C-w Describe how there is no warranty for Calc."
(message "Calc Help options: Help, Info, ... press SPC, DEL to scroll, C-g to cancel")
(memq (setq key (read-event))
'(? ?\C-h ?\C-? ?\C-v ?\M-v)))
- (condition-case err
+ (condition-case nil
(if (memq key '(? ?\C-v))
(scroll-up)
(scroll-down))
@@ -302,21 +302,19 @@ C-w Describe how there is no warranty for Calc."
(let ((entrylist '())
entry)
(require 'info nil t)
- (while indices
- (condition-case nil
- (with-temp-buffer
- (Info-mode)
- (Info-goto-node (concat "(Calc)" (car indices) " Index"))
- (goto-char (point-min))
- (while (re-search-forward "\n\\* \\(.*\\): " nil t)
- (setq entry (match-string 1))
- (if (and (not (string-match "<[1-9]+>" entry))
- (not (string-match "(.*)" entry))
- (not (string= entry "Menu")))
- (unless (assoc entry entrylist)
- (setq entrylist (cons entry entrylist))))))
- (error nil))
- (setq indices (cdr indices)))
+ (dolist (indice indices)
+ (ignore-errors
+ (with-temp-buffer
+ (Info-mode)
+ (Info-goto-node (concat "(Calc)" indice " Index"))
+ (goto-char (point-min))
+ (while (re-search-forward "\n\\* \\(.*\\): " nil t)
+ (setq entry (match-string 1))
+ (if (and (not (string-match "<[1-9]+>" entry))
+ (not (string-match "(.*)" entry))
+ (not (string= entry "Menu")))
+ (unless (assoc entry entrylist)
+ (setq entrylist (cons entry entrylist))))))))
entrylist))
(defun calc-describe-function (&optional func)
@@ -409,9 +407,7 @@ C-w Describe how there is no warranty for Calc."
(substitute-command-keys x)))))
(nreverse (cdr (reverse (cdr (calc-help))))))
(mapc (function (lambda (prefix)
- (let ((msgs (condition-case err
- (funcall prefix)
- (error nil))))
+ (let ((msgs (ignore-errors (funcall prefix))))
(if (car msgs)
(princ
(if (eq (nth 2 msgs) ?v)
diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el
index c6264d1f5f9..2c7a4f0561e 100644
--- a/lisp/calc/calc-incom.el
+++ b/lisp/calc/calc-incom.el
@@ -1,4 +1,4 @@
-;;; calc-incom.el --- complex data type input functions for Calc
+;;; calc-incom.el --- complex data type input functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el
index ecf43a12b0c..47917dcac7e 100644
--- a/lisp/calc/calc-keypd.el
+++ b/lisp/calc/calc-keypd.el
@@ -1,4 +1,4 @@
-;;; calc-keypd.el --- mouse-capable keypad input for Calc
+;;; calc-keypd.el --- mouse-capable keypad input for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -35,17 +35,17 @@
(defvar calc-keypad-prev-input nil)
(defvar calc-keypad-said-hello nil)
-;;; |----+----+----+----+----+----|
-;;; | ENTER |+/- |EEX |UNDO| <- |
-;;; |-----+---+-+--+--+-+---++----|
-;;; | INV | 7 | 8 | 9 | / |
-;;; |-----+-----+-----+-----+-----|
-;;; | HYP | 4 | 5 | 6 | * |
-;;; |-----+-----+-----+-----+-----|
-;;; |EXEC | 1 | 2 | 3 | - |
-;;; |-----+-----+-----+-----+-----|
-;;; | OFF | 0 | . | PI | + |
-;;; |-----+-----+-----+-----+-----|
+;; |----+----+----+----+----+----|
+;; | ENTER |+/- |EEX |UNDO| <- |
+;; |-----+---+-+--+--+-+---++----|
+;; | INV | 7 | 8 | 9 | / |
+;; |-----+-----+-----+-----+-----|
+;; | HYP | 4 | 5 | 6 | * |
+;; |-----+-----+-----+-----+-----|
+;; |EXEC | 1 | 2 | 3 | - |
+;; |-----+-----+-----+-----+-----|
+;; | OFF | 0 | . | PI | + |
+;; |-----+-----+-----+-----+-----|
(defvar calc-keypad-layout
'( ( ( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
( "ENTER" calc-enter calc-roll-down calc-roll-up calc-over )
@@ -83,12 +83,12 @@
calc-keypad-modes-menu
calc-keypad-user-menu ) )
-;;; |----+----+----+----+----+----|
-;;; |FLR |CEIL|RND |TRNC|CLN2|FLT |
-;;; |----+----+----+----+----+----|
-;;; | LN |EXP | |ABS |IDIV|MOD |
-;;; |----+----+----+----+----+----|
-;;; |SIN |COS |TAN |SQRT|y^x |1/x |
+;; |----+----+----+----+----+----|
+;; |FLR |CEIL|RND |TRNC|CLN2|FLT |
+;; |----+----+----+----+----+----|
+;; | LN |EXP | |ABS |IDIV|MOD |
+;; |----+----+----+----+----+----|
+;; |SIN |COS |TAN |SQRT|y^x |1/x |
(defvar calc-keypad-math-menu
'( ( ( "FLR" calc-floor )
@@ -110,12 +110,12 @@
( "y^x" calc-power )
( "1/x" calc-inv ) ) ))
-;;; |----+----+----+----+----+----|
-;;; |IGAM|BETA|IBET|ERF |BESJ|BESY|
-;;; |----+----+----+----+----+----|
-;;; |IMAG|CONJ| RE |ATN2|RAND|RAGN|
-;;; |----+----+----+----+----+----|
-;;; |GCD |FACT|DFCT|BNOM|PERM|NXTP|
+;; |----+----+----+----+----+----|
+;; |IGAM|BETA|IBET|ERF |BESJ|BESY|
+;; |----+----+----+----+----+----|
+;; |IMAG|CONJ| RE |ATN2|RAND|RAGN|
+;; |----+----+----+----+----+----|
+;; |GCD |FACT|DFCT|BNOM|PERM|NXTP|
(defvar calc-keypad-funcs-menu
'( ( ( "IGAM" calc-inc-gamma )
@@ -137,12 +137,12 @@
( "PERM" calc-perm )
( "NXTP" calc-next-prime calc-prev-prime ) ) ))
-;;; |----+----+----+----+----+----|
-;;; |AND | OR |XOR |NOT |LSH |RSH |
-;;; |----+----+----+----+----+----|
-;;; |DEC |HEX |OCT |BIN |WSIZ|ARSH|
-;;; |----+----+----+----+----+----|
-;;; | A | B | C | D | E | F |
+;; |----+----+----+----+----+----|
+;; |AND | OR |XOR |NOT |LSH |RSH |
+;; |----+----+----+----+----+----|
+;; |DEC |HEX |OCT |BIN |WSIZ|ARSH|
+;; |----+----+----+----+----+----|
+;; | A | B | C | D | E | F |
(defvar calc-keypad-binary-menu
'( ( ( "AND" calc-and calc-diff )
@@ -164,12 +164,12 @@
( "E" ("E") )
( "F" ("F") ) ) ))
-;;; |----+----+----+----+----+----|
-;;; |SUM |PROD|MAX |MAP*|MAP^|MAP$|
-;;; |----+----+----+----+----+----|
-;;; |INV |DET |TRN |IDNT|CRSS|"x" |
-;;; |----+----+----+----+----+----|
-;;; |PACK|UNPK|INDX|BLD |LEN |... |
+;; |----+----+----+----+----+----|
+;; |SUM |PROD|MAX |MAP*|MAP^|MAP$|
+;; |----+----+----+----+----+----|
+;; |INV |DET |TRN |IDNT|CRSS|"x" |
+;; |----+----+----+----+----+----|
+;; |PACK|UNPK|INDX|BLD |LEN |... |
(defvar calc-keypad-vector-menu
'( ( ( "SUM" calc-vector-sum calc-vector-alt-sum calc-vector-mean )
@@ -196,12 +196,12 @@
( "LEN" calc-vlength )
( "..." calc-full-vectors ) ) ))
-;;; |----+----+----+----+----+----|
-;;; |FLT |FIX |SCI |ENG |GRP | |
-;;; |----+----+----+----+----+----|
-;;; |RAD |DEG |FRAC|POLR|SYMB|PREC|
-;;; |----+----+----+----+----+----|
-;;; |SWAP|RLL3|RLL4|OVER|STO |RCL |
+;; |----+----+----+----+----+----|
+;; |FLT |FIX |SCI |ENG |GRP | |
+;; |----+----+----+----+----+----|
+;; |RAD |DEG |FRAC|POLR|SYMB|PREC|
+;; |----+----+----+----+----+----|
+;; |SWAP|RLL3|RLL4|OVER|STO |RCL |
(defvar calc-keypad-modes-menu
'( ( ( "FLT" calc-normal-notation
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index 4bbe850273d..bde5abe649f 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -1,4 +1,4 @@
-;;; calc-lang.el --- calc language functions
+;;; calc-lang.el --- calc language functions -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -45,6 +45,8 @@
(defvar math-comp-comma)
(defvar math-comp-vector-prec)
+(defvar math-exp-str) ;; Dyn scoped
+
;;; Alternate entry/display languages.
(defun calc-set-language (lang &optional option no-refresh)
@@ -144,7 +146,7 @@
( y1 . (math-C-parse-bess))
( tgamma . calcFunc-gamma )))
-(defun math-C-parse-bess (f val)
+(defun math-C-parse-bess (_f val)
"Parse C's j0, j1, y0, y1 functions."
(let ((args (math-read-expr-list)))
(math-read-token)
@@ -155,7 +157,7 @@
((eq val 'y1) '(calcFunc-besY 1)))
args)))
-(defun math-C-parse-fma (f val)
+(defun math-C-parse-fma (_f _val)
"Parse C's fma function fma(x,y,z) => (x * y + z)."
(let ((args (math-read-expr-list)))
(math-read-token)
@@ -372,14 +374,14 @@
(defvar math-exp-old-pos)
(defvar math-parsing-fortran-vector nil)
-(defun math-parse-fortran-vector (op)
+(defun math-parse-fortran-vector (_op)
(let ((math-parsing-fortran-vector '(end . "\000")))
(prog1
(math-read-brackets t "]")
(setq math-exp-token (car math-parsing-fortran-vector)
math-expr-data (cdr math-parsing-fortran-vector)))))
-(defun math-parse-fortran-vector-end (x op)
+(defun math-parse-fortran-vector-end (x _op)
(if math-parsing-fortran-vector
(progn
(setq math-parsing-fortran-vector (cons math-exp-token math-expr-data)
@@ -466,10 +468,10 @@
( "\\times" * 191 190 )
( "*" * 191 190 )
( "2x" * 191 190 )
+ ( "/" / 185 186 )
( "+" + 180 181 )
( "-" - 180 181 )
( "\\over" / 170 171 )
- ( "/" / 170 171 )
( "\\choose" calcFunc-choose 170 171 )
( "\\mod" % 170 171 )
( "<" calcFunc-lt 160 161 )
@@ -692,7 +694,7 @@
"_{" (math-compose-expr (nth 2 a) 0)
"}{" (math-compose-expr (nth 1 a) 0) "}"))))
-(defun math-parse-tex-sum (f val)
+(defun math-parse-tex-sum (f _val)
(let (low high save)
(or (equal math-expr-data "_") (throw 'syntax "Expected `_'"))
(math-read-token)
@@ -727,14 +729,15 @@
(math-compose-expr (nth 3 a) 0)
(if (memq (nth 1 a) '(0 2)) ")" "]")))
-(defun math-compose-tex-var (a prec)
+(defun math-compose-tex-var (a _prec)
(if (and calc-language-option
(not (= calc-language-option 0))
(string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'"
(symbol-name (nth 1 a))))
- (if (eq calc-language 'latex)
- (format "\\text{%s}" (symbol-name (nth 1 a)))
- (format "\\hbox{%s}" (symbol-name (nth 1 a))))
+ (format (if (eq calc-language 'latex)
+ "\\text{%s}"
+ "\\hbox{%s}")
+ (symbol-name (nth 1 a)))
(math-compose-var a)))
(defun math-compose-tex-func (func a)
@@ -906,7 +909,7 @@
(setq math-exp-str (copy-sequence math-exp-str))
(aset math-exp-str right ?\]))))))))))
-(defun math-latex-parse-frac (f val)
+(defun math-latex-parse-frac (_f _val)
(let (numer denom)
(setq numer (car (math-read-expr-list)))
(math-read-token)
@@ -916,7 +919,7 @@
(list 'frac numer denom)
(list '/ numer denom))))
-(defun math-latex-parse-two-args (f val)
+(defun math-latex-parse-two-args (f _val)
(let (first second)
(setq first (car (math-read-expr-list)))
(math-read-token)
@@ -931,7 +934,7 @@
(put 'latex 'math-input-filter 'math-tex-input-filter)
-(defun calc-eqn-language (n)
+(defun calc-eqn-language (_n)
(interactive "P")
(calc-wrapper
(calc-set-language 'eqn)
@@ -1159,7 +1162,7 @@
(math-compose-eqn-matrix (cdr a)))))))
nil))
-(defun math-parse-eqn-matrix (f sym)
+(defun math-parse-eqn-matrix (_f _sym)
(let ((vec nil))
(while (assoc math-expr-data '(("ccol") ("lcol") ("rcol")))
(math-read-token)
@@ -1175,7 +1178,7 @@
(math-read-token)
(math-transpose (cons 'vec (nreverse vec)))))
-(defun math-parse-eqn-prime (x sym)
+(defun math-parse-eqn-prime (x _sym)
(if (eq (car-safe x) 'var)
(if (equal math-expr-data calc-function-open)
(progn
@@ -1363,7 +1366,7 @@
(math-compose-vector args ", " 0)
"]")))))
-(defun math-yacas-parse-Sum (f val)
+(defun math-yacas-parse-Sum (f _val)
"Read in the arguments to \"Sum\" in Calc's Yacas mode."
(let ((args (math-read-expr-list)))
(math-read-token)
@@ -1512,7 +1515,7 @@
( substitute . (math-maxima-parse-subst))
( taylor . (math-maxima-parse-taylor))))
-(defun math-maxima-parse-subst (f val)
+(defun math-maxima-parse-subst (_f _val)
"Read in the arguments to \"subst\" in Calc's Maxima mode."
(let ((args (math-read-expr-list)))
(math-read-token)
@@ -1521,7 +1524,7 @@
(nth 2 args)
(nth 0 args))))
-(defun math-maxima-parse-taylor (f val)
+(defun math-maxima-parse-taylor (_f _val)
"Read in the arguments to \"taylor\" in Calc's Maxima mode."
(let ((args (math-read-expr-list)))
(math-read-token)
@@ -1762,7 +1765,7 @@
( contains . (math-lang-switch-args calcFunc-in))
( has . (math-lang-switch-args calcFunc-refers))))
-(defun math-lang-switch-args (f val)
+(defun math-lang-switch-args (f _val)
"Read the arguments to a Calc function in reverse order.
This is used for various language modes which have functions in reverse
order to Calc's."
@@ -1805,15 +1808,15 @@ order to Calc's."
(put 'giac 'math-compose-subscr
(function
(lambda (a)
- (let ((args (cdr (cdr a))))
+ ;; (let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-expr
(calc-normalize (list '- (nth 2 a) 1)) 0)
- "]")))))
+ "]")))) ;;)
-(defun math-read-giac-subscr (x op)
+(defun math-read-giac-subscr (x _op)
(let ((idx (math-read-expr-level 0)))
(or (equal math-expr-data "]")
(throw 'syntax "Expected `]'"))
@@ -1947,7 +1950,7 @@ order to Calc's."
(math-compose-expr (nth 2 a) 0)
"]]"))))
-(defun math-read-math-subscr (x op)
+(defun math-read-math-subscr (x _op)
(let ((idx (math-read-expr-level 0)))
(or (and (equal math-expr-data "]")
(progn
@@ -2094,10 +2097,13 @@ order to Calc's."
(defvar math-rb-v1)
(defvar math-rb-v2)
-(defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2
+(defun math-read-big-rec (rb-h1 rb-v1 rb-h2 rb-v2
&optional baseline prec short)
(or prec (setq prec 0))
-
+ (let ((math-rb-h1 rb-h1)
+ (math-rb-v1 rb-v1)
+ (math-rb-h2 rb-h2)
+ (math-rb-v2 rb-v2))
;; Clip whitespace above or below.
(while (and (< math-rb-v1 math-rb-v2)
(math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1)))
@@ -2449,7 +2455,7 @@ order to Calc's."
math-read-big-h2 h)
(or short (= math-read-big-h2 math-rb-h2)
(math-read-big-error h baseline))
- p)))
+ p))))
(defun math-read-big-char (h v)
(or (and (>= h math-rb-h1)
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el
index 257d369b87a..5aaa5f48d6c 100644
--- a/lisp/calc/calc-macs.el
+++ b/lisp/calc/calc-macs.el
@@ -61,6 +61,7 @@
(defmacro calc-with-trail-buffer (&rest body)
`(let ((save-buf (current-buffer))
(calc-command-flags nil))
+ (ignore save-buf) ;FIXME: Use a name less conflict-prone!
(with-current-buffer (calc-trail-display t)
(progn
(goto-char calc-trail-pointer)
diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el
index 139ba5b8e38..0ee82826927 100644
--- a/lisp/calc/calc-map.el
+++ b/lisp/calc/calc-map.el
@@ -1,4 +1,4 @@
-;;; calc-map.el --- higher-order functions for Calc
+;;; calc-map.el --- higher-order functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -48,6 +48,8 @@
(math-calcFunc-to-var (nth 1 oper))
expr)))))
+(defvar calc-mapping-dir nil)
+
(defun calc-reduce (&optional oper accum)
(interactive)
(calc-wrapper
@@ -136,7 +138,6 @@
(1+ calc-dollar-used))))))))
(defvar calc-verify-arglist t)
-(defvar calc-mapping-dir nil)
(defun calc-map-stack ()
"This is meant to be called by calc-keypad mode."
(interactive)
@@ -492,6 +493,8 @@
(defvar calc-get-operator-history nil
"History for calc-get-operator.")
+(defvar math-arglist)
+
(defun calc-get-operator (msg &optional nargs)
(setq calc-aborted-prefix nil)
(let ((inv nil) (hyp nil) (prefix nil) (forcenargs nil)
@@ -853,7 +856,7 @@
(i -1)
(math-working-step 0)
(math-working-step-2 nil)
- len cols obj expr)
+ len obj expr) ;; cols
(if (eq mode 'eqn)
(setq mode 'elems
heads '(calcFunc-eq calcFunc-neq calcFunc-lt calcFunc-gt
@@ -1023,22 +1026,21 @@
(let ((expr (car (setq vec (cdr vec)))))
(if expr
(progn
- (condition-case err
- (and (symbolp func)
- (let ((lfunc (or (cdr (assq func
- '( (calcFunc-add . math-add)
- (calcFunc-sub . math-sub)
- (calcFunc-mul . math-mul)
- (calcFunc-div . math-div)
- (calcFunc-pow . math-pow)
- (calcFunc-mod . math-mod)
- (calcFunc-vconcat .
- math-concat) )))
- func)))
- (while (cdr vec)
- (setq expr (funcall lfunc expr (nth 1 vec))
- vec (cdr vec)))))
- (error nil))
+ (ignore-errors
+ (and (symbolp func)
+ (let ((lfunc (or (cdr (assq func
+ '( (calcFunc-add . math-add)
+ (calcFunc-sub . math-sub)
+ (calcFunc-mul . math-mul)
+ (calcFunc-div . math-div)
+ (calcFunc-pow . math-pow)
+ (calcFunc-mod . math-mod)
+ (calcFunc-vconcat
+ . math-concat) )))
+ func)))
+ (while (cdr vec)
+ (setq expr (funcall lfunc expr (nth 1 vec))
+ vec (cdr vec))))))
(while (setq vec (cdr vec))
(setq expr (math-build-call func (list expr (car vec)))))
(math-normalize expr))
@@ -1229,9 +1231,11 @@
(defvar math-inner-mul-func)
(defvar math-inner-add-func)
-(defun calcFunc-inner (math-inner-mul-func math-inner-add-func a b)
+(defun calcFunc-inner (inner-mul-func inner-add-func a b)
(or (math-vectorp a) (math-reject-arg a 'vectorp))
(or (math-vectorp b) (math-reject-arg b 'vectorp))
+ (let ((math-inner-mul-func inner-mul-func)
+ (math-inner-add-func inner-add-func))
(if (math-matrixp a)
(if (math-matrixp b)
(if (= (length (nth 1 a)) (length b))
@@ -1247,12 +1251,12 @@
(math-dimension-error))))
(if (math-matrixp b)
(nth 1 (math-inner-mats (list 'vec a) b))
- (calcFunc-reduce math-inner-add-func (calcFunc-map math-inner-mul-func a b)))))
+ (calcFunc-reduce math-inner-add-func (calcFunc-map math-inner-mul-func a b))))))
(defun math-inner-mats (a b)
(let ((mat nil)
(cols (length (nth 1 b)))
- row col ap bp accum)
+ row col) ;; ap bp accum
(while (setq a (cdr a))
(setq col cols
row nil)
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 6bbd2f574e5..46172d1b7f6 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -1,4 +1,4 @@
-;;; calc-math.el --- mathematical functions for Calc
+;;; calc-math.el --- mathematical functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -60,33 +60,23 @@
pow
(< pow 1.0e+INF))
(setq x (* 2 x))
- (setq pow (condition-case nil
- (expt 10.0 (* 2 x))
- (error nil))))
+ (setq pow (ignore-errors (expt 10.0 (* 2 x)))))
;; The following loop should stop when 10^(x+1) is too large.
- (setq pow (condition-case nil
- (expt 10.0 (1+ x))
- (error nil)))
+ (setq pow (ignore-errors (expt 10.0 (1+ x))))
(while (and
pow
(< pow 1.0e+INF))
(setq x (1+ x))
- (setq pow (condition-case nil
- (expt 10.0 (1+ x))
- (error nil))))
+ (setq pow (ignore-errors (expt 10.0 (1+ x)))))
(1- x))
"The largest exponent which Calc will convert to an Emacs float.")
(defvar math-smallest-emacs-expt
(let ((x -1))
- (while (condition-case nil
- (> (expt 10.0 x) 0.0)
- (error nil))
+ (while (ignore-errors (> (expt 10.0 x) 0.0))
(setq x (* 2 x)))
(setq x (/ x 2))
- (while (condition-case nil
- (> (expt 10.0 x) 0.0)
- (error nil))
+ (while (ignore-errors (> (expt 10.0 x) 0.0))
(setq x (1- x)))
(+ x 2))
"The smallest exponent which Calc will convert to an Emacs float.")
@@ -100,19 +90,18 @@ If this can't be done, return NIL."
(let* ((xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x))))))
(and (<= math-smallest-emacs-expt xpon)
(<= xpon math-largest-emacs-expt)
- (condition-case nil
- (math-read-number
- (number-to-string
- (funcall fn
- (string-to-number
- (let
- ((calc-number-radix 10)
- (calc-twos-complement-mode nil)
- (calc-float-format (list 'float calc-internal-prec))
- (calc-group-digits nil)
- (calc-point-char "."))
- (math-format-number (math-float x)))))))
- (error nil))))))
+ (ignore-errors
+ (math-read-number
+ (number-to-string
+ (funcall fn
+ (string-to-number
+ (let
+ ((calc-number-radix 10)
+ (calc-twos-complement-mode nil)
+ (calc-float-format (list 'float calc-internal-prec))
+ (calc-group-digits nil)
+ (calc-point-char "."))
+ (math-format-number (math-float x))))))))))))
(defun calc-sqrt (arg)
(interactive "P")
@@ -638,11 +627,11 @@ If this can't be done, return NIL."
(defvar math-nrf-nf)
(defvar math-nrf-nfm1)
-(defun math-nth-root-float (a math-nrf-n &optional guess)
+(defun math-nth-root-float (a nrf-n &optional guess)
(math-inexact-result)
(math-with-extra-prec 1
- (let ((math-nrf-nf (math-float math-nrf-n))
- (math-nrf-nfm1 (math-float (1- math-nrf-n))))
+ (let ((math-nrf-nf (math-float nrf-n))
+ (math-nrf-nfm1 (math-float (1- nrf-n))))
(math-nth-root-float-iter a (or guess
(math-make-float
1 (/ (+ (math-numdigs (nth 1 a))
@@ -665,11 +654,12 @@ If this can't be done, return NIL."
;; math-nth-root-int.
(defvar math-nri-n)
-(defun math-nth-root-integer (a math-nri-n &optional guess) ; [I I S]
- (math-nth-root-int-iter a (or guess
- (math-scale-int 1 (/ (+ (math-numdigs a)
- (1- math-nri-n))
- math-nri-n)))))
+(defun math-nth-root-integer (a nri-n &optional guess) ; [I I S]
+ (let ((math-nri-n nri-n))
+ (math-nth-root-int-iter a (or guess
+ (math-scale-int 1 (/ (+ (math-numdigs a)
+ (1- nri-n))
+ nri-n))))))
(defun math-nth-root-int-iter (a guess)
(math-working "root" guess)
@@ -693,13 +683,13 @@ If this can't be done, return NIL."
;;;; Transcendental functions.
-;;; All of these functions are defined on the complex plane.
-;;; (Branch cuts, etc. follow Steele's Common Lisp book.)
+;; All of these functions are defined on the complex plane.
+;; (Branch cuts, etc. follow Steele's Common Lisp book.)
-;;; Most functions increase calc-internal-prec by 2 digits, then round
-;;; down afterward. "-raw" functions use the current precision, require
-;;; their arguments to be in float (or complex float) format, and always
-;;; work in radians (where applicable).
+;; Most functions increase calc-internal-prec by 2 digits, then round
+;; down afterward. "-raw" functions use the current precision, require
+;; their arguments to be in float (or complex float) format, and always
+;; work in radians (where applicable).
(defun math-to-radians (a) ; [N N]
(cond ((eq (car-safe a) 'hms)
@@ -1126,9 +1116,9 @@ If this can't be done, return NIL."
(math-div-float (cdr sc) (car sc)))))))
-;;; This could use a smarter method: Reduce x as in math-sin-raw, then
-;;; compute either sin(x) or cos(x), whichever is smaller, and compute
-;;; the other using the identity sin(x)^2 + cos(x)^2 = 1.
+;; This could use a smarter method: Reduce x as in math-sin-raw, then
+;; compute either sin(x) or cos(x), whichever is smaller, and compute
+;; the other using the identity sin(x)^2 + cos(x)^2 = 1.
(defun math-sin-cos-raw (x) ; [F.F F] (result is (sin x . cos x))
(cons (math-sin-raw x) (math-cos-raw x)))
@@ -2072,7 +2062,7 @@ If this can't be done, return NIL."
(put 'calcFunc-arctanh 'math-expandable t)
-;;; Convert A from HMS or degrees to radians.
+;; Convert A from HMS or degrees to radians.
(defun calcFunc-rad (a) ; [R R] [Public]
(cond ((or (Math-numberp a)
(eq (car a) 'intv))
@@ -2089,7 +2079,7 @@ If this can't be done, return NIL."
(t (list 'calcFunc-rad a))))
(put 'calcFunc-rad 'math-expandable t)
-;;; Convert A from HMS or radians to degrees.
+;; Convert A from HMS or radians to degrees.
(defun calcFunc-deg (a) ; [R R] [Public]
(cond ((or (Math-numberp a)
(eq (car a) 'intv))
diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el
index 3cc98ef59c3..d593eddb315 100644
--- a/lisp/calc/calc-menu.el
+++ b/lisp/calc/calc-menu.el
@@ -1,4 +1,4 @@
-;;; calc-menu.el --- a menu for Calc
+;;; calc-menu.el --- a menu for Calc -*- lexical-binding:t -*-
;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index a8f65ffe752..2db09e2b677 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -1,4 +1,4 @@
-;;; calc-misc.el --- miscellaneous functions for Calc
+;;; calc-misc.el --- miscellaneous functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -505,7 +505,7 @@ With argument 0, switch line point is in with line mark is in."
;; 3 <-- mid-line = 3
;; 4 <-- point
;; 5 <-- bot-line = 5
- (dotimes (i mid-line)
+ (dotimes (_ mid-line)
(setq mid-cell old-top-list
old-top-list (cdr old-top-list))
(setcdr mid-cell new-top-list)
@@ -519,7 +519,7 @@ With argument 0, switch line point is in with line mark is in."
;; 2
;; 1
(setq prev-mid-cell old-top-list)
- (dotimes (i (- bot-line mid-line))
+ (dotimes (_ (- bot-line mid-line))
(setq bot-cell old-top-list
old-top-list (cdr old-top-list))
(setcdr bot-cell new-top-list)
@@ -757,19 +757,21 @@ loaded and the keystroke automatically re-typed."
;; The variable math-trunc-prec is local to math-trunc, but used by
;; math-trunc-fancy in calc-arith.el, which is called by math-trunc.
+(defvar math-trunc-prec)
;;;###autoload
-(defun math-trunc (a &optional math-trunc-prec)
- (cond (math-trunc-prec
+(defun math-trunc (a &optional trunc-prec)
+ (cond (trunc-prec
(require 'calc-ext)
- (math-trunc-special a math-trunc-prec))
+ (math-trunc-special a trunc-prec))
((Math-integerp a) a)
((Math-looks-negp a)
(math-neg (math-trunc (math-neg a))))
((eq (car a) 'float)
(math-scale-int (nth 1 a) (nth 2 a)))
(t (require 'calc-ext)
- (math-trunc-fancy a))))
+ (let ((math-trunc-prec trunc-prec))
+ (math-trunc-fancy a)))))
;;;###autoload
(defalias 'calcFunc-trunc 'math-trunc)
@@ -777,12 +779,13 @@ loaded and the keystroke automatically re-typed."
;; The variable math-floor-prec is local to math-floor, but used by
;; math-floor-fancy in calc-arith.el, which is called by math-floor.
+(defvar math-floor-prec)
;;;###autoload
-(defun math-floor (a &optional math-floor-prec) ; [Public]
- (cond (math-floor-prec
+(defun math-floor (a &optional floor-prec) ; [Public]
+ (cond (floor-prec
(require 'calc-ext)
- (math-floor-special a math-floor-prec))
+ (math-floor-special a floor-prec))
((Math-integerp a) a)
((Math-messy-integerp a) (math-trunc a))
((Math-realp a)
@@ -790,7 +793,9 @@ loaded and the keystroke automatically re-typed."
(math-add (math-trunc a) -1)
(math-trunc a)))
(t (require 'calc-ext)
- (math-floor-fancy a))))
+ (let ((math-floor-prec floor-prec))
+ (math-floor-fancy a)))))
+
;;;###autoload
(defalias 'calcFunc-floor 'math-floor)
diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el
index ff99ccc466c..e109233a825 100644
--- a/lisp/calc/calc-mode.el
+++ b/lisp/calc/calc-mode.el
@@ -1,4 +1,4 @@
-;;; calc-mode.el --- calculator modes for Calc
+;;; calc-mode.el --- calculator modes for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -424,8 +424,8 @@
(t
"Not recording mode changes permanently")))))
-(defun calc-total-algebraic-mode (flag)
- (interactive "P")
+(defun calc-total-algebraic-mode (&optional _flag)
+ (interactive)
(calc-wrapper
(if (eq calc-algebraic-mode 'total)
(calc-algebraic-mode nil)
diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el
index fe241b57c60..8deef7dc4fd 100644
--- a/lisp/calc/calc-mtx.el
+++ b/lisp/calc/calc-mtx.el
@@ -1,4 +1,4 @@
-;;; calc-mtx.el --- matrix functions for Calc
+;;; calc-mtx.el --- matrix functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -275,7 +275,7 @@ in LUD decomposition."
k (1+ k)))
(setcar (nthcdr j (nth i lu)) sum)
(let ((dum (math-lud-pivot-check sum)))
- (if (Math-lessp big dum)
+ (if (or (math-zerop big) (Math-lessp big dum))
(setq big dum
imax i)))
(setq i (1+ i)))
diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el
index 0fe955b28d1..5ed85fe7cae 100644
--- a/lisp/calc/calc-nlfit.el
+++ b/lisp/calc/calc-nlfit.el
@@ -1,4 +1,4 @@
-;;; calc-nlfit.el --- nonlinear curve fitting for Calc
+;;; calc-nlfit.el --- nonlinear curve fitting for Calc -*- lexical-binding:t -*-
;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
@@ -104,19 +104,19 @@
(list 'vec C12 C22))))
(list A B)))))
-;;; The methods described by de Sousa require the cumulative data qdata
-;;; and the rates pdata. We will assume that we are given either
-;;; qdata and the corresponding times tdata, or pdata and the corresponding
-;;; tdata. The following two functions will find pdata or qdata,
-;;; given the other..
+;; The methods described by de Sousa require the cumulative data qdata
+;; and the rates pdata. We will assume that we are given either
+;; qdata and the corresponding times tdata, or pdata and the corresponding
+;; tdata. The following two functions will find pdata or qdata,
+;; given the other..
-;;; First, given two lists; one of values q0, q1, ..., qn and one of
-;;; corresponding times t0, t1, ..., tn; return a list
-;;; p0, p1, ..., pn of the rates of change of the qi with respect to t.
-;;; p0 is the right hand derivative (q1 - q0)/(t1 - t0).
-;;; pn is the left hand derivative (qn - q(n-1))/(tn - t(n-1)).
-;;; The other pis are the averages of the two:
-;;; (1/2)((qi - q(i-1))/(ti - t(i-1)) + (q(i+1) - qi)/(t(i+1) - ti)).
+;; First, given two lists; one of values q0, q1, ..., qn and one of
+;; corresponding times t0, t1, ..., tn; return a list
+;; p0, p1, ..., pn of the rates of change of the qi with respect to t.
+;; p0 is the right hand derivative (q1 - q0)/(t1 - t0).
+;; pn is the left hand derivative (qn - q(n-1))/(tn - t(n-1)).
+;; The other pis are the averages of the two:
+;; (1/2)((qi - q(i-1))/(ti - t(i-1)) + (q(i+1) - qi)/(t(i+1) - ti)).
(defun math-nlfit-get-rates-from-cumul (tdata qdata)
(let ((pdata (list
@@ -153,12 +153,12 @@
pdata))
(reverse pdata)))
-;;; Next, given two lists -- one of rates p0, p1, ..., pn and one of
-;;; corresponding times t0, t1, ..., tn -- and an initial values q0,
-;;; return a list q0, q1, ..., qn of the cumulative values.
-;;; q0 is the initial value given.
-;;; For i>0, qi is computed using the trapezoid rule:
-;;; qi = q(i-1) + (1/2)(pi + p(i-1))(ti - t(i-1))
+;; Next, given two lists -- one of rates p0, p1, ..., pn and one of
+;; corresponding times t0, t1, ..., tn -- and an initial values q0,
+;; return a list q0, q1, ..., qn of the cumulative values.
+;; q0 is the initial value given.
+;; For i>0, qi is computed using the trapezoid rule:
+;; qi = q(i-1) + (1/2)(pi + p(i-1))(ti - t(i-1))
(defun math-nlfit-get-cumul-from-rates (tdata pdata q0)
(let* ((qdata (list q0)))
@@ -177,16 +177,16 @@
(setq tdata (cdr tdata)))
(reverse qdata)))
-;;; Given the qdata, pdata and tdata, find the parameters
-;;; a, b and c that fit q = a/(1+b*exp(c*t)).
-;;; a is found using the method described by de Sousa.
-;;; b and c are found using least squares on the linearization
-;;; log((a/q)-1) = log(b) + c*t
-;;; In some cases (where the logistic curve may well be the wrong
-;;; model), the computed a will be less than or equal to the maximum
-;;; value of q in qdata; in which case the above linearization won't work.
-;;; In this case, a will be replaced by a number slightly above
-;;; the maximum value of q.
+;; Given the qdata, pdata and tdata, find the parameters
+;; a, b and c that fit q = a/(1+b*exp(c*t)).
+;; a is found using the method described by de Sousa.
+;; b and c are found using least squares on the linearization
+;; log((a/q)-1) = log(b) + c*t
+;; In some cases (where the logistic curve may well be the wrong
+;; model), the computed a will be less than or equal to the maximum
+;; value of q in qdata; in which case the above linearization won't work.
+;; In this case, a will be replaced by a number slightly above
+;; the maximum value of q.
(defun math-nlfit-find-qmax (qdata pdata tdata)
(let* ((ratios (math-map-binop 'math-div pdata qdata))
@@ -208,12 +208,12 @@
(calcFunc-exp (nth 0 bandc))
(nth 1 bandc))))
-;;; Next, given the pdata and tdata, we can find the qdata if we know q0.
-;;; We first try to find q0, using the fact that when p takes on its largest
-;;; value, q is half of its maximum value. So we'll find the maximum value
-;;; of q given various q0, and use bisection to approximate the correct q0.
+;; Next, given the pdata and tdata, we can find the qdata if we know q0.
+;; We first try to find q0, using the fact that when p takes on its largest
+;; value, q is half of its maximum value. So we'll find the maximum value
+;; of q given various q0, and use bisection to approximate the correct q0.
-;;; First, given pdata and tdata, find what half of qmax would be if q0=0.
+;; First, given pdata and tdata, find what half of qmax would be if q0=0.
(defun math-nlfit-find-qmaxhalf (pdata tdata)
(let ((pmax (math-max-list (car pdata) (cdr pdata)))
@@ -231,7 +231,7 @@
(setq tdata (cdr tdata)))
qmh))
-;;; Next, given pdata and tdata, approximate q0.
+;; Next, given pdata and tdata, approximate q0.
(defun math-nlfit-find-q0 (pdata tdata)
(let* ((qhalf (math-nlfit-find-qmaxhalf pdata tdata))
@@ -250,7 +250,7 @@
(setq q0 (math-add q0 qhalf)))
(let* ((qmin (math-sub q0 qhalf))
(qmax q0)
- (qt (math-nlfit-find-qmax
+ (_qt (math-nlfit-find-qmax
(mapcar
(lambda (q) (math-add q0 q))
qdata)
@@ -270,20 +270,20 @@
(setq i (1+ i)))
(math-mul '(float 5 -1) (math-add qmin qmax)))))
-;;; To improve the approximations to the parameters, we can use
-;;; Marquardt method as described in Schwarz's book.
+;; To improve the approximations to the parameters, we can use
+;; Marquardt method as described in Schwarz's book.
-;;; Small numbers used in the Givens algorithm
+;; Small numbers used in the Givens algorithm
(defvar math-nlfit-delta '(float 1 -8))
(defvar math-nlfit-epsilon '(float 1 -5))
-;;; Maximum number of iterations
+;; Maximum number of iterations
(defvar math-nlfit-max-its 100)
-;;; Next, we need some functions for dealing with vectors and
-;;; matrices. For convenience, we'll work with Emacs lists
-;;; as vectors, rather than Calc's vectors.
+;; Next, we need some functions for dealing with vectors and
+;; matrices. For convenience, we'll work with Emacs lists
+;; as vectors, rather than Calc's vectors.
(defun math-nlfit-set-elt (vec i x)
(setcar (nthcdr (1- i) vec) x))
@@ -589,7 +589,7 @@
(calcFunc-trn j) j))
(calcFunc-inv j)))
-(defun math-nlfit-get-sigmas (grad xlist pparms chisq)
+(defun math-nlfit-get-sigmas (grad xlist pparms _chisq)
(let* ((sgs nil)
(covar (math-nlfit-find-covar grad xlist pparms))
(n (1- (length covar)))
@@ -664,6 +664,10 @@
(calc-pop-push-record-list n prefix vals)
(calc-handle-whys))
+(defvar calc-curve-nvars)
+(defvar calc-curve-varnames)
+(defvar calc-curve-coefnames)
+
(defun math-nlfit-fit-curve (fn grad solnexpr initparms &optional sdv)
(calc-slow-wrapper
(let* ((sdevv (or (eq sdv 'calcFunc-efit) (eq sdv 'calcFunc-xfit)))
@@ -678,7 +682,7 @@
(calc-curve-varnames nil)
(calc-curve-coefnames nil)
(calc-curve-nvars 1)
- (fitvars (calc-get-fit-variables 1 3))
+ (_fitvars (calc-get-fit-variables 1 3))
(var (nth 1 calc-curve-varnames))
(parms (cdr calc-curve-coefnames))
(parmguess
@@ -763,7 +767,7 @@
(calc-curve-varnames nil)
(calc-curve-coefnames nil)
(calc-curve-nvars 1)
- (fitvars (calc-get-fit-variables 1 2))
+ (_fitvars (calc-get-fit-variables 1 2))
(var (nth 1 calc-curve-varnames))
(parms (cdr calc-curve-coefnames))
(soln (list '* (nth 0 finalparms)
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 6db5de4c96c..ea9c49748e2 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -1,4 +1,4 @@
-;;; calc-prog.el --- user programmability functions for Calc
+;;; calc-prog.el --- user programmability functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -111,10 +111,15 @@
"Not reporting timing of commands"))))
(defun calc-pass-errors ()
+ ;; FIXME: This is broken at least since Emacs-26.
+ ;; AFAICT the immediate purpose of this code is to hack the
+ ;; `condition-case' in `calc-do' so it doesn't catch errors any
+ ;; more. I'm not sure why/whatfor this was designed, but I suspect
+ ;; that `condition-case-unless-debug' would cover the same needs.
(interactive)
;; The following two cases are for the new, optimizing byte compiler
;; or the standard 18.57 byte compiler, respectively.
- (condition-case err
+ (condition-case nil
(let ((place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 15)))
(or (memq (car-safe (car-safe place)) '(error xxxerror))
(setq place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 27)))
@@ -165,6 +170,7 @@
;; calc-user-define-composition and calc-finish-formula-edit,
;; but is used by calc-fix-user-formula.
(defvar calc-user-formula-alist)
+(defvar math-arglist) ; dynamically bound in all callers
(defun calc-user-define-formula ()
(interactive)
@@ -328,7 +334,6 @@
(setcdr kmap (cons (cons key cmd) (cdr kmap)))))))
(message "")))
-(defvar math-arglist) ; dynamically bound in all callers
(defun calc-default-formula-arglist (form)
(if (consp form)
(if (eq (car form) 'var)
@@ -511,8 +516,9 @@
;; is called (indirectly) by calc-read-parse-table.
(defvar calc-lang)
-(defun calc-write-parse-table (tab calc-lang)
- (let ((p tab))
+(defun calc-write-parse-table (tab lang)
+ (let ((calc-lang lang)
+ (p tab))
(while p
(calc-write-parse-table-part (car (car p)))
(insert ":= "
@@ -551,8 +557,9 @@
(insert " "))))
(setq p (cdr p))))
-(defun calc-read-parse-table (calc-buf calc-lang)
- (let ((tab nil))
+(defun calc-read-parse-table (calc-buf lang)
+ (let ((calc-lang lang)
+ (tab nil))
(while (progn
(skip-chars-forward "\n\t ")
(not (eobp)))
@@ -860,7 +867,7 @@
(defun calc-edit-macro-combine-digits ()
"Put an entire sequence of digits on a single line."
(let ((line (calc-edit-macro-command))
- curline)
+ ) ;; curline
(goto-char (line-beginning-position))
(kill-line 1)
(while (string-equal (calc-edit-macro-command-type) "calcDigit-start")
@@ -1038,7 +1045,7 @@ Redefine the corresponding command."
(let* ((cmd (cdr def))
(fcmd (and cmd (symbolp cmd) (symbol-function cmd)))
(func nil)
- (pt (point))
+ ;; (pt (point))
(fill-column 70)
(fill-prefix nil)
str q-ok)
@@ -1945,8 +1952,9 @@ Redefine the corresponding command."
;; by math-define-body.
(defvar math-exp-env)
-(defun math-define-body (body math-exp-env)
- (math-define-list body))
+(defun math-define-body (body exp-env)
+ (let ((math-exp-env exp-env))
+ (math-define-list body)))
(defun math-define-list (body &optional quote)
(cond ((null body)
diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el
index bb909e728e1..2cc7b6beef0 100644
--- a/lisp/calc/calc-rewr.el
+++ b/lisp/calc/calc-rewr.el
@@ -1,4 +1,4 @@
-;;; calc-rewr.el --- rewriting functions for Calc
+;;; calc-rewr.el --- rewriting functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -142,7 +142,7 @@
(calc-pop-push-record-list n "rwrt" (list expr)))
(calc-handle-whys)))
-(defun calc-match (pat &optional interactive)
+(defun calc-match (pat &optional _interactive)
(interactive "sPattern: \np")
(calc-slow-wrapper
(let (n expr)
@@ -158,9 +158,9 @@
(setq expr (calc-top-n 1)
n 1))
(or (math-vectorp expr) (error "Argument must be a vector"))
- (if (calc-is-inverse)
- (calc-enter-result n "mtcn" (math-match-patterns pat expr t))
- (calc-enter-result n "mtch" (math-match-patterns pat expr nil))))))
+ (calc-enter-result n "mtcn"
+ (math-match-patterns pat expr
+ (not (not (calc-is-inverse))))))))
(defvar math-mt-many)
@@ -169,8 +169,10 @@
;; but is used by math-rewrite-phase
(defvar math-rewrite-whole-expr)
-(defun math-rewrite (math-rewrite-whole-expr rules &optional math-mt-many)
- (let* ((crules (math-compile-rewrites rules))
+(defun math-rewrite (rewrite-whole-expr rules &optional mt-many)
+ (let* ((math-rewrite-whole-expr rewrite-whole-expr)
+ (math-mt-many mt-many)
+ (crules (math-compile-rewrites rules))
(heads (math-rewrite-heads math-rewrite-whole-expr))
(trace-buffer (get-buffer "*Trace*"))
(calc-display-just 'center)
@@ -211,6 +213,8 @@
":\n" fmt "\n"))))
math-rewrite-whole-expr))
+(defvar math-rewrite-phase 1)
+
(defun math-rewrite-phase (sched)
(while (and sched (/= math-mt-many 0))
(if (listp (car sched))
@@ -464,6 +468,8 @@
;;; whole match the name v. Beware of circular structures!
;;;
+(defvar math-rewrite-whole nil)
+
(defun math-compile-patterns (pats)
(if (and (eq (car-safe pats) 'var)
(calc-var-value (nth 2 pats)))
@@ -485,7 +491,6 @@
(cdr pats)
(list pats)))))))))
-(defvar math-rewrite-whole nil)
(defvar math-make-import-list nil)
;; The variable math-import-list is local to part of math-compile-rewrites,
@@ -580,7 +585,7 @@
(let ((rule-set nil)
(all-heads nil)
(nil-rules nil)
- (rule-count 0)
+ ;; (rule-count 0)
(math-schedule nil)
(math-iterations nil)
(math-phases nil)
@@ -831,14 +836,16 @@
(defvar math-rwcomp-subst-new-func)
(defvar math-rwcomp-subst-old-func)
-(defun math-rwcomp-substitute (expr math-rwcomp-subst-old math-rwcomp-subst-new)
- (if (and (eq (car-safe math-rwcomp-subst-old) 'var)
- (memq (car-safe math-rwcomp-subst-new) '(var calcFunc-lambda)))
- (let ((math-rwcomp-subst-old-func (math-var-to-calcFunc math-rwcomp-subst-old))
- (math-rwcomp-subst-new-func (math-var-to-calcFunc math-rwcomp-subst-new)))
+(defun math-rwcomp-substitute (expr rwcomp-subst-old rwcomp-subst-new)
+ (let ((math-rwcomp-subst-old rwcomp-subst-old)
+ (math-rwcomp-subst-new rwcomp-subst-new))
+ (if (and (eq (car-safe rwcomp-subst-old) 'var)
+ (memq (car-safe rwcomp-subst-new) '(var calcFunc-lambda)))
+ (let ((math-rwcomp-subst-old-func (math-var-to-calcFunc rwcomp-subst-old))
+ (math-rwcomp-subst-new-func (math-var-to-calcFunc rwcomp-subst-new)))
(math-rwcomp-subst-rec expr))
(let ((math-rwcomp-subst-old-func nil))
- (math-rwcomp-subst-rec expr))))
+ (math-rwcomp-subst-rec expr)))))
(defun math-rwcomp-subst-rec (expr)
(cond ((equal expr math-rwcomp-subst-old) math-rwcomp-subst-new)
@@ -1452,8 +1459,6 @@
,form
(setcar rules orig))))
-(defvar math-rewrite-phase 1)
-
;; The variable math-apply-rw-regs is local to math-apply-rewrites,
;; but is used by math-rwapply-replace-regs and math-rwapply-reg-looks-negp
;; which are called by math-apply-rewrites.
@@ -1463,11 +1468,12 @@
;; but is used by math-rwapply-remember.
(defvar math-apply-rw-ruleset)
-(defun math-apply-rewrites (expr rules &optional heads math-apply-rw-ruleset)
+(defun math-apply-rewrites (expr rules &optional heads apply-rw-ruleset)
(and
(setq rules (cdr (or (assq (car-safe expr) rules)
(assq nil rules))))
- (let ((result nil)
+ (let ((math-apply-rw-ruleset apply-rw-ruleset)
+ (result nil)
op math-apply-rw-regs inst part pc mark btrack
(tracing math-rwcomp-tracing)
(phase math-rewrite-phase))
diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el
index 1b7526c3c9e..fe0e8a1e479 100644
--- a/lisp/calc/calc-rules.el
+++ b/lisp/calc/calc-rules.el
@@ -1,4 +1,4 @@
-;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc
+;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el
index 0342a0ae48c..23c0e01b527 100644
--- a/lisp/calc/calc-sel.el
+++ b/lisp/calc/calc-sel.el
@@ -1,4 +1,4 @@
-;;; calc-sel.el --- data selection functions for Calc
+;;; calc-sel.el --- data selection functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -146,7 +146,8 @@
(defvar calc-fnp-op)
(defvar calc-fnp-num)
-(defun calc-find-nth-part (expr calc-fnp-num)
+(defun calc-find-nth-part (expr fnp-num)
+ (let ((calc-fnp-num fnp-num))
(if (and calc-assoc-selections
(assq (car-safe expr) calc-assoc-ops))
(let (calc-fnp-op)
@@ -154,7 +155,7 @@
(if (eq (car-safe expr) 'intv)
(and (>= calc-fnp-num 1) (<= calc-fnp-num 2) (nth (1+ calc-fnp-num) expr))
(and (not (Math-primp expr)) (>= calc-fnp-num 1) (< calc-fnp-num (length expr))
- (nth calc-fnp-num expr)))))
+ (nth calc-fnp-num expr))))))
(defun calc-find-nth-part-rec (expr) ; uses num, op
(or (if (and (setq calc-fnp-op (assq (car-safe (nth 1 expr)) calc-assoc-ops))
@@ -381,7 +382,7 @@
;; (if (or (< num 1) (> num (calc-stack-size)))
;; (error "Cursor must be positioned on a stack element"))
(let* ((entry (calc-top num 'entry))
- ww w)
+ ) ;; ww w
(or (equal entry calc-selection-cache-entry)
(progn
(setcar entry (calc-encase-atoms (car entry)))
@@ -418,6 +419,7 @@
;; The variable math-comp-sel-tag is local to calc-find-selected-part,
;; but is used by math-comp-sel-flat-term and math-comp-add-string-sel
;; in calccomp.el, which are called (indirectly) by calc-find-selected-part.
+(defvar math-comp-sel-tag)
(defun calc-find-selected-part ()
(let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset))
@@ -436,7 +438,8 @@
(current-indentation))
lcount (1+ lcount)))
(- lcount (math-comp-ascent
- calc-selection-cache-comp) -1))))
+ calc-selection-cache-comp)
+ -1))))
(math-comp-sel-cpos (- (point) toppt calc-selection-cache-offset
spaces lcount))
(math-comp-sel-tag nil))
@@ -481,8 +484,9 @@
(defvar calc-rsf-old)
(defvar calc-rsf-new)
-(defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new)
- (setq calc-rsf-new (calc-encase-atoms calc-rsf-new))
+(defun calc-replace-sub-formula (expr rsf-old rsf-new)
+ (let ((calc-rsf-old rsf-old)
+ (calc-rsf-new (calc-encase-atoms rsf-new))))
(calc-replace-sub-formula-rec expr))
(defun calc-replace-sub-formula-rec (expr)
@@ -671,7 +675,7 @@
(entry (calc-top num 'entry))
(expr (car entry))
(sel (or (calc-auto-selection entry) expr))
- alg)
+ ) ;; alg
(let ((str (math-showing-full-precision
(math-format-nice-expr sel (frame-width)))))
(calc-edit-mode (list 'calc-finish-selection-edit
diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el
index 09d3ce921c4..196f743fc1a 100644
--- a/lisp/calc/calc-stat.el
+++ b/lisp/calc/calc-stat.el
@@ -1,4 +1,4 @@
-;;; calc-stat.el --- statistical functions for Calc
+;;; calc-stat.el --- statistical functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index 5282b834021..a1e385cb406 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -1,4 +1,4 @@
-;;; calc-store.el --- value storage functions for Calc
+;;; calc-store.el --- value storage functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -184,10 +184,11 @@
(defvar calc-read-var-name-history nil
"History for reading variable names.")
-(defun calc-read-var-name (prompt &optional calc-store-opers)
+(defun calc-read-var-name (prompt &optional store-opers)
(setq calc-given-value nil
calc-aborted-prefix nil)
- (let ((var (concat
+ (let* ((calc-store-opers store-opers)
+ (var (concat
"var-"
(let ((minibuffer-completion-table
(mapcar (lambda (x) (substring x 4))
@@ -428,11 +429,11 @@
(defun calc-edit-variable (&optional var)
(interactive)
(calc-wrapper
- (or var (setq var (calc-read-var-name
- (if calc-last-edited-variable
- (format "Edit (default %s): "
- (calc-var-name calc-last-edited-variable))
- "Edit: "))))
+ (unless var
+ (setq var (calc-read-var-name
+ (format-prompt "Edit" (and calc-last-edited-variable
+ (calc-var-name
+ calc-last-edited-variable))))))
(or var (setq var calc-last-edited-variable))
(if var
(let* ((value (calc-var-value var)))
@@ -504,7 +505,7 @@
(calc-wrapper
(or var (setq var (calc-read-var-name "Declare: " 0)))
(or var (setq var 'var-All))
- (let* (dp decl def row rp)
+ (let* (dp decl row rp) ;; def
(or (and (calc-var-value 'var-Decls)
(eq (car-safe var-Decls) 'vec))
(setq var-Decls (list 'vec)))
diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el
index bbd61a2c4a8..58b81faee50 100644
--- a/lisp/calc/calc-stuff.el
+++ b/lisp/calc/calc-stuff.el
@@ -1,4 +1,4 @@
-;;; calc-stuff.el --- miscellaneous functions for Calc
+;;; calc-stuff.el --- miscellaneous functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -273,8 +273,9 @@ With a prefix, push that prefix as a number onto the stack."
;; math-map-over-constants.
(defvar math-moc-func)
-(defun math-map-over-constants (math-moc-func expr)
- (math-map-over-constants-rec expr))
+(defun math-map-over-constants (moc-func expr)
+ (let ((math-moc-func moc-func))
+ (math-map-over-constants-rec expr)))
(defun math-map-over-constants-rec (expr)
(cond ((or (Math-primp expr)
diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el
index 9f289f21b00..de7205ee3ca 100644
--- a/lisp/calc/calc-trail.el
+++ b/lisp/calc/calc-trail.el
@@ -1,4 +1,4 @@
-;;; calc-trail.el --- functions for manipulating the Calc "trail"
+;;; calc-trail.el --- functions for manipulating the Calc "trail" -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el
index 92682baa87a..47971e8ab0d 100644
--- a/lisp/calc/calc-undo.el
+++ b/lisp/calc/calc-undo.el
@@ -1,4 +1,4 @@
-;;; calc-undo.el --- undo functions for Calc
+;;; calc-undo.el --- undo functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 7b86eb095b0..709c09ea099 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -37,14 +37,14 @@
;;; Updated April 2002 by Jochen Küpper
;;; Updated August 2007, using
-;;; CODATA (http://physics.nist.gov/cuu/Constants/index.html)
-;;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
+;;; CODATA (https://physics.nist.gov/cuu/Constants/index.html)
+;;; NIST (https://physics.nist.gov/Pubs/SP811/appenB9.html)
;;; ESUWM (Encyclopaedia of Scientific Units, Weights and
;;; Measures, by François Cardarelli)
;;; All conversions are exact unless otherwise noted.
;; CODATA values updated February 2016, using 2014 adjustment
-;; http://arxiv.org/pdf/1507.07956.pdf
+;; https://arxiv.org/pdf/1507.07956.pdf
;; Updated November 2018 for the redefinition of the SI
;; https://www.bipm.org/utils/en/pdf/CGPM/Draft-Resolution-A-EN.pdf
@@ -59,7 +59,7 @@
( mi "5280 ft" "Mile" )
( au "149597870691. m" "Astronomical Unit" nil
"149597870691 m (*)")
- ;; (approx) NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html)
+ ;; (approx) NASA JPL (https://neo.jpl.nasa.gov/glossary/au.html)
( lyr "c yr" "Light Year" )
( pc "3.0856775854*10^16 m" "Parsec (**)" nil
"3.0856775854 10^16 m (*)") ;; (approx) ESUWM
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el
index 6850ded717b..875414595cf 100644
--- a/lisp/calc/calc-vec.el
+++ b/lisp/calc/calc-vec.el
@@ -1,4 +1,4 @@
-;;; calc-vec.el --- vector functions for Calc
+;;; calc-vec.el --- vector functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -1111,18 +1111,20 @@
;; by calcFunc-grade and calcFunc-rgrade.
(defvar math-grade-vec)
-(defun calcFunc-grade (math-grade-vec)
- (if (math-vectorp math-grade-vec)
- (let* ((len (1- (length math-grade-vec))))
- (cons 'vec (sort (cdr (calcFunc-index len)) 'math-grade-beforep)))
- (math-reject-arg math-grade-vec 'vectorp)))
-
-(defun calcFunc-rgrade (math-grade-vec)
- (if (math-vectorp math-grade-vec)
- (let* ((len (1- (length math-grade-vec))))
+(defun calcFunc-grade (grade-vec)
+ (if (math-vectorp grade-vec)
+ (let* ((math-grade-vec grade-vec)
+ (len (1- (length grade-vec))))
+ (cons 'vec (sort (cdr (calcFunc-index len)) #'math-grade-beforep)))
+ (math-reject-arg grade-vec #'vectorp)))
+
+(defun calcFunc-rgrade (grade-vec)
+ (if (math-vectorp grade-vec)
+ (let* ((math-grade-vec grade-vec)
+ (len (1- (length grade-vec))))
(cons 'vec (nreverse (sort (cdr (calcFunc-index len))
- 'math-grade-beforep))))
- (math-reject-arg math-grade-vec 'vectorp)))
+ #'math-grade-beforep))))
+ (math-reject-arg grade-vec #'vectorp)))
(defun math-grade-beforep (i j)
(math-beforep (nth i math-grade-vec) (nth j math-grade-vec)))
@@ -1556,7 +1558,8 @@ of two matrices is a matrix."
(defvar math-exp-keep-spaces)
(defvar math-expr-data)
-(defun math-read-brackets (space-sep math-rb-close)
+(defun math-read-brackets (space-sep rb-close)
+ (let ((math-rb-close rb-close))
(and space-sep (setq space-sep (not (math-check-for-commas))))
(math-read-token)
(while (eq math-exp-token 'space)
@@ -1624,7 +1627,7 @@ of two matrices is a matrix."
(throw 'syntax "Expected `]'")))
(or (eq math-exp-token 'end)
(math-read-token))
- vals)))
+ vals))))
(defun math-check-for-commas (&optional balancing)
(let ((count 0)
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index f5150ca552c..e03c00243c4 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -1,4 +1,4 @@
-;;; calc-yank.el --- kill-ring functionality for Calc
+;;; calc-yank.el --- kill-ring functionality for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -150,34 +150,16 @@
;; otherwise it just parses the yanked string.
;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96
;;;###autoload
-(defun calc-yank (radix)
- "Yank a value into the Calculator buffer.
-
-Valid numeric prefixes for RADIX: 0, 2, 6, 8
-No radix notation is prepended for any other numeric prefix.
-
-If RADIX is 2, prepend \"2#\" - Binary.
-If RADIX is 8, prepend \"8#\" - Octal.
-If RADIX is 0, prepend \"10#\" - Decimal.
-If RADIX is 6, prepend \"16#\" - Hexadecimal.
+(defun calc-yank-internal (radix thing-raw)
+ "Internal common implementation for yank functions.
-If RADIX is a non-nil list (created using \\[universal-argument]), the user
-will be prompted to enter the radix in the minibuffer.
-
-If RADIX is nil or if the yanked string already has a calc radix prefix, the
-yanked string will be passed on directly to the Calculator buffer without any
-alteration."
- (interactive "P")
+This function is used by both `calc-yank' and `calc-yank-mouse-primary'."
(calc-wrapper
(calc-pop-push-record-list
0 "yank"
(let* (radix-num
radix-notation
valid-num-regexp
- (thing-raw
- (if (fboundp 'current-kill)
- (current-kill 0 t)
- (car kill-ring-yank-pointer)))
(thing
(if (or (null radix)
;; Match examples: -2#10, 10\n(10#10,01)
@@ -232,6 +214,38 @@ alteration."
val))
val))))))))
+;;;###autoload
+(defun calc-yank-mouse-primary (radix)
+ "Yank the current primary selection into the Calculator buffer.
+See `calc-yank' for details about RADIX."
+ (interactive "P")
+ (if (or select-enable-primary
+ select-enable-clipboard)
+ (calc-yank-internal radix (gui-get-primary-selection))
+ ;; Yank from the kill ring.
+ (calc-yank radix)))
+
+;;;###autoload
+(defun calc-yank (radix)
+ "Yank a value into the Calculator buffer.
+
+Valid numeric prefixes for RADIX: 0, 2, 6, 8
+No radix notation is prepended for any other numeric prefix.
+
+If RADIX is 2, prepend \"2#\" - Binary.
+If RADIX is 8, prepend \"8#\" - Octal.
+If RADIX is 0, prepend \"10#\" - Decimal.
+If RADIX is 6, prepend \"16#\" - Hexadecimal.
+
+If RADIX is a non-nil list (created using \\[universal-argument]), the user
+will be prompted to enter the radix in the minibuffer.
+
+If RADIX is nil or if the yanked string already has a calc radix prefix, the
+yanked string will be passed on directly to the Calculator buffer without any
+alteration."
+ (interactive "P")
+ (calc-yank-internal radix (current-kill 0 t)))
+
;;; The Calc set- and get-register commands are modified versions of functions
;;; in register.el
@@ -387,7 +401,7 @@ Interactively, reads the register using `register-read-with-preview'."
(let* ((from-buffer (current-buffer))
(calc-was-started (get-buffer-window "*Calculator*"))
(single nil)
- data vals pos)
+ data vals) ;; pos
(if arg
(if (consp arg)
(setq single t)
@@ -762,7 +776,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(error "Original calculator buffer has been corrupted")))
(goto-char calc-edit-top)
(if (buffer-modified-p)
- (eval calc-edit-handler))
+ (eval calc-edit-handler t))
(if (and one-window (not (one-window-p t)))
(delete-window))
(if (get-buffer-window return)
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 648cb7bb807..5716189b342 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -884,6 +884,8 @@ Used by `calc-user-invocation'.")
(defvar calc-load-hook nil
"Hook run when calc.el is loaded.")
+(make-obsolete-variable 'calc-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defvar calc-window-hook nil
"Hook called to create the Calc window.")
@@ -1085,8 +1087,26 @@ Used by `calc-user-invocation'.")
(append (where-is-internal 'delete-backward-char global-map)
(where-is-internal 'backward-delete-char global-map)
(where-is-internal 'backward-delete-char-untabify global-map)
- '("\C-d"))
- '("\177" "\C-d")))
+ '("\177"))
+ '("\177")))
+
+(mapc (lambda (x)
+ (ignore-errors
+ (define-key calc-digit-map x 'calcDigit-delchar)
+ (define-key calc-mode-map x 'calc-pop)
+ (define-key calc-mode-map
+ (if (and (vectorp x) (featurep 'xemacs))
+ (if (= (length x) 1)
+ (vector (if (consp (aref x 0))
+ (cons 'meta (aref x 0))
+ (list 'meta (aref x 0))))
+ "\e\C-d")
+ (vconcat "\e" x))
+ 'calc-pop-above)))
+ (if calc-scan-for-dels
+ (append (where-is-internal 'delete-forward-char global-map)
+ '("\C-d"))
+ '("\C-d")))
(defvar calc-dispatch-map
(let ((map (make-keymap)))
@@ -1362,6 +1382,29 @@ Notations: 3.14e6 3.14 * 10^6
(set-keymap-parent map calc-mode-map)
map))
+(defun calc--header-line (long short width &optional fudge)
+ "Return a Calc header line appropriate for the buffer width.
+
+LONG is a desired text for a wide window, SHORT is a desired
+abbreviated text, and width is the buffer width, which will be
+some fraction of the 'parent' window width (At the time of
+writing, 2/3 for calc, 1/3 for trail). The optional FUDGE is a
+trial-and-error adjustment number for the edge-cases at the
+border of the two cases."
+ ;; TODO: This could be called as part of a 'window-resize' hook.
+ (setq header-line-format
+ (let* ((len-long (length long))
+ (len-short (length short))
+ (fudge (or fudge 0))
+ ;; fudge for trail is: -3 (added to len-long)
+ ;; (width ) for trail
+ (factor (if (> width (+ len-long fudge)) len-long len-short))
+ (size (max (/ (- width factor) 2) 0))
+ (fill (make-string size ?-))
+ (pre (replace-regexp-in-string ".$" " " fill))
+ (post (replace-regexp-in-string "^." " " fill)))
+ (concat pre (if (= factor len-long) long short) post))))
+
(define-derived-mode calc-trail-mode fundamental-mode "Calc Trail"
"Calc Trail mode.
This mode is used by the *Calc Trail* buffer, which records all results
@@ -1376,9 +1419,9 @@ commands given here will actually operate on the *Calculator* stack."
(setq buffer-read-only t)
(make-local-variable 'overlay-arrow-position)
(make-local-variable 'overlay-arrow-string)
- (when (= (buffer-size) 0)
- (let ((inhibit-read-only t))
- (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))))
+ (when calc-show-banner
+ (calc--header-line "Emacs Calculator Trail" "Calc Trail"
+ (/ (window-width) 3) -3)))
(defun calc-create-buffer ()
"Create and initialize a buffer for the Calculator."
@@ -1392,6 +1435,12 @@ commands given here will actually operate on the *Calculator* stack."
(require 'calc-ext)
(calc-set-language calc-language calc-language-option t)))
+(defcustom calc-make-windows-dedicated t
+ "If non-nil, windows displaying Calc buffers will be marked dedicated.
+See `window-dedicated-p' for what that means."
+ :version "28.1"
+ :type 'boolean)
+
;;;###autoload
(defun calc (&optional arg full-display interactive)
"The Emacs Calculator. Full documentation is listed under `calc-mode'."
@@ -1431,13 +1480,14 @@ commands given here will actually operate on the *Calculator* stack."
(pop-to-buffer (current-buffer)))))))
(with-current-buffer (calc-trail-buffer)
(and calc-display-trail
- (= (window-width) (frame-width))
(calc-trail-display 1 t)))
(message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit")
(run-hooks 'calc-start-hook)
(and (windowp full-display)
(window-point full-display)
(select-window full-display))
+ (and calc-make-windows-dedicated
+ (set-window-dedicated-p nil t))
(calc-check-defines)
(when (and calc-said-hello interactive)
(sit-for 2)
@@ -1966,13 +2016,11 @@ See calc-keypad for details."
(calc-any-evaltos nil))
(setq calc-any-selections nil)
(erase-buffer)
- (when calc-show-banner
- (insert (propertize "--- Emacs Calculator Mode ---\n"
- 'face 'italic)))
+ (when calc-show-banner
+ (calc--header-line "Emacs Calculator Mode" "Emacs Calc"
+ (* 2 (/ (window-width) 3)) -3))
(while thing
(goto-char (point-min))
- (when calc-show-banner
- (forward-line 1))
(insert (math-format-stack-value (car thing)) "\n")
(setq thing (cdr thing)))
(calc-renumber-stack)
@@ -2056,7 +2104,6 @@ the United States."
(eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
(with-current-buffer calc-trail-buffer
(goto-char (point-min))
- (forward-line 1)
(setq calc-trail-pointer (point-marker))))
calc-trail-buffer)
@@ -2101,7 +2148,9 @@ the United States."
(if calc-trail-window-hook
(run-hooks 'calc-trail-window-hook)
(let ((w (split-window nil (/ (* (window-width) 2) 3) t)))
- (set-window-buffer w calc-trail-buffer)))
+ (set-window-buffer w calc-trail-buffer)
+ (and calc-make-windows-dedicated
+ (set-window-dedicated-p nil t))))
(calc-wrapper
(setq overlay-arrow-string calc-trail-overlay
overlay-arrow-position calc-trail-pointer)
@@ -2124,10 +2173,8 @@ the United States."
(if (derived-mode-p 'calc-trail-mode)
(progn
(beginning-of-line)
- (if (bobp)
- (forward-line 1)
- (if (eobp)
- (forward-line -1)))
+ (if (eobp)
+ (forward-line -1))
(if (or (bobp) (eobp))
(setq overlay-arrow-position nil) ; trail is empty
(set-marker calc-trail-pointer (point) (current-buffer))
@@ -2141,7 +2188,7 @@ the United States."
(if win
(save-excursion
(forward-line (/ (window-height win) 2))
- (forward-line (- 1 (window-height win)))
+ (forward-line (- 2 (window-height win)))
(set-window-start win (point))
(set-window-point win (+ calc-trail-pointer 4))
(set-buffer calc-main-buffer)
@@ -2276,7 +2323,7 @@ the United States."
((eq last-command-event ?@) "0@ ")
(t (char-to-string last-command-event))))
-(defvar calc-buffer)
+(defvar calc-buffer nil)
(defvar calc-prev-char)
(defvar calc-prev-prev-char)
(defvar calc-digit-value)
@@ -2316,7 +2363,7 @@ the United States."
(defun calcDigit-nondigit ()
(interactive)
;; Exercise for the reader: Figure out why this is a good precaution!
- (or (boundp 'calc-buffer)
+ (or calc-buffer
(use-local-map minibuffer-local-map))
(let ((str (minibuffer-contents)))
(setq calc-digit-value (with-current-buffer calc-buffer
@@ -2341,7 +2388,6 @@ the United States."
(defun calcDigit-key ()
(interactive)
- (goto-char (point-max))
(if (or (and (memq last-command-event '(?+ ?-))
(> (buffer-size) 0)
(/= (preceding-char) ?e))
@@ -2384,8 +2430,7 @@ the United States."
(delete-char 1))
(if (looking-at "-")
(delete-char 1)
- (insert "-")))
- (goto-char (point-max)))
+ (insert "-"))))
((eq last-command-event ?p)
(if (or (calc-minibuffer-contains ".*\\+/-.*")
(calc-minibuffer-contains ".*mod.*")
@@ -2427,7 +2472,7 @@ the United States."
(if (and (memq last-command-event '(?@ ?o ?h ?\' ?m))
(string-match " " calc-hms-format))
(insert " "))
- (if (and (eq this-command last-command)
+ (if (and (memq last-command '(calcDigit-start calcDigit-key))
(eq last-command-event ?.))
(progn
(require 'calc-ext)
@@ -2438,17 +2483,9 @@ the United States."
(setq calc-prev-prev-char calc-prev-char
calc-prev-char last-command-event))
-
(defun calcDigit-backspace ()
(interactive)
- (goto-char (point-max))
- (cond ((calc-minibuffer-contains ".* \\+/- \\'")
- (backward-delete-char 5))
- ((calc-minibuffer-contains ".* mod \\'")
- (backward-delete-char 5))
- ((calc-minibuffer-contains ".* \\'")
- (backward-delete-char 2))
- ((eq last-command 'calcDigit-start)
+ (cond ((eq last-command 'calcDigit-start)
(erase-buffer))
(t (backward-delete-char 1)))
(if (= (calc-minibuffer-size) 0)
@@ -2923,6 +2960,20 @@ the United States."
(- (- (nth 2 a) (nth 2 b)) ldiff))))
+(defun calcDigit-delchar ()
+ (interactive)
+ (cond ((looking-at-p " \\+/- \\'")
+ (delete-char 5))
+ ((looking-at-p " mod \\'")
+ (delete-char 5))
+ ((looking-at-p " \\'")
+ (delete-char 2))
+ ((eq last-command 'calcDigit-start)
+ (erase-buffer))
+ (t (unless (eobp) (delete-char 1))))
+ (when (= (calc-minibuffer-size) 0)
+ (setq last-command-event 13)
+ (calcDigit-nondigit)))
(defvar math-comp-selected)
@@ -3411,12 +3462,10 @@ See Info node `(calc)Defining Functions'."
(defun calc-clear-unread-commands ()
(setq unread-command-events nil))
-(defcalcmodevar math-2-word-size
- (math-read-number-simple "4294967296")
+(defcalcmodevar math-2-word-size 4294967296
"Two to the power of `calc-word-size'.")
-(defcalcmodevar math-half-2-word-size
- (math-read-number-simple "2147483648")
+(defcalcmodevar math-half-2-word-size 2147483648
"One-half of two to the power of `calc-word-size'.")
(when calc-always-load-extensions
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index bcfa77dad94..bf4d6261910 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -1,4 +1,4 @@
-;;; calcalg2.el --- more algebraic functions for Calc
+;;; calcalg2.el --- more algebraic functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -333,8 +333,10 @@
(setq n (1+ n)))
accum))))))
-(defun calcFunc-deriv (expr math-deriv-var &optional deriv-value math-deriv-symb)
- (let* ((math-deriv-total nil)
+(defun calcFunc-deriv (expr deriv-var &optional deriv-value deriv-symb)
+ (let* ((math-deriv-var deriv-var)
+ (math-deriv-symb deriv-symb)
+ (math-deriv-total nil)
(res (catch 'math-deriv (math-derivative expr))))
(or (eq (car-safe res) 'calcFunc-deriv)
(null res)
@@ -344,9 +346,11 @@
(math-expr-subst res math-deriv-var deriv-value)
res))))
-(defun calcFunc-tderiv (expr math-deriv-var &optional deriv-value math-deriv-symb)
+(defun calcFunc-tderiv (expr deriv-var &optional deriv-value deriv-symb)
(math-setup-declarations)
- (let* ((math-deriv-total t)
+ (let* ((math-deriv-var deriv-var)
+ (math-deriv-symb deriv-symb)
+ (math-deriv-total t)
(res (catch 'math-deriv (math-derivative expr))))
(or (eq (car-safe res) 'calcFunc-tderiv)
(null res)
@@ -357,175 +361,175 @@
res))))
(put 'calcFunc-inv\' 'math-derivative-1
- (function (lambda (u) (math-neg (math-div 1 (math-sqr u))))))
+ (lambda (u) (math-neg (math-div 1 (math-sqr u)))))
(put 'calcFunc-sqrt\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u))))))
+ (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u)))))
(put 'calcFunc-deg\' 'math-derivative-1
- (function (lambda (u) (math-div-float '(float 18 1) (math-pi)))))
+ (lambda (_) (math-div-float '(float 18 1) (math-pi))))
(put 'calcFunc-rad\' 'math-derivative-1
- (function (lambda (u) (math-pi-over-180))))
+ (lambda (_) (math-pi-over-180)))
(put 'calcFunc-ln\' 'math-derivative-1
- (function (lambda (u) (math-div 1 u))))
+ (lambda (u) (math-div 1 u)))
(put 'calcFunc-log10\' 'math-derivative-1
- (function (lambda (u)
- (math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
- u))))
+ (lambda (u)
+ (math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
+ u)))
(put 'calcFunc-lnp1\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-add u 1)))))
+ (lambda (u) (math-div 1 (math-add u 1))))
(put 'calcFunc-log\' 'math-derivative-2
- (function (lambda (x b)
- (and (not (Math-zerop b))
- (let ((lnv (math-normalize
- (list 'calcFunc-ln b))))
- (math-div 1 (math-mul lnv x)))))))
+ (lambda (x b)
+ (and (not (Math-zerop b))
+ (let ((lnv (math-normalize
+ (list 'calcFunc-ln b))))
+ (math-div 1 (math-mul lnv x))))))
(put 'calcFunc-log\'2 'math-derivative-2
- (function (lambda (x b)
- (let ((lnv (list 'calcFunc-ln b)))
- (math-neg (math-div (list 'calcFunc-log x b)
- (math-mul lnv b)))))))
+ (lambda (x b)
+ (let ((lnv (list 'calcFunc-ln b)))
+ (math-neg (math-div (list 'calcFunc-log x b)
+ (math-mul lnv b))))))
(put 'calcFunc-exp\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-exp u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-exp u))))
(put 'calcFunc-expm1\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-expm1 u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-expm1 u))))
(put 'calcFunc-sin\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2 (math-normalize
- (list 'calcFunc-cos u)) t))))
+ (lambda (u) (math-to-radians-2 (math-normalize
+ (list 'calcFunc-cos u)) t)))
(put 'calcFunc-cos\' 'math-derivative-1
- (function (lambda (u) (math-neg (math-to-radians-2
- (math-normalize
- (list 'calcFunc-sin u)) t)))))
+ (lambda (u) (math-neg (math-to-radians-2
+ (math-normalize
+ (list 'calcFunc-sin u)) t))))
(put 'calcFunc-tan\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2
- (math-sqr
- (math-normalize
- (list 'calcFunc-sec u))) t))))
+ (lambda (u) (math-to-radians-2
+ (math-sqr
+ (math-normalize
+ (list 'calcFunc-sec u))) t)))
(put 'calcFunc-sec\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2
- (math-mul
- (math-normalize
- (list 'calcFunc-sec u))
- (math-normalize
- (list 'calcFunc-tan u))) t))))
+ (lambda (u) (math-to-radians-2
+ (math-mul
+ (math-normalize
+ (list 'calcFunc-sec u))
+ (math-normalize
+ (list 'calcFunc-tan u))) t)))
(put 'calcFunc-csc\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-to-radians-2
- (math-mul
- (math-normalize
- (list 'calcFunc-csc u))
- (math-normalize
- (list 'calcFunc-cot u))) t)))))
+ (lambda (u) (math-neg
+ (math-to-radians-2
+ (math-mul
+ (math-normalize
+ (list 'calcFunc-csc u))
+ (math-normalize
+ (list 'calcFunc-cot u))) t))))
(put 'calcFunc-cot\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-to-radians-2
- (math-sqr
- (math-normalize
- (list 'calcFunc-csc u))) t)))))
+ (lambda (u) (math-neg
+ (math-to-radians-2
+ (math-sqr
+ (math-normalize
+ (list 'calcFunc-csc u))) t))))
(put 'calcFunc-arcsin\' 'math-derivative-1
- (function (lambda (u)
- (math-from-radians-2
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr u))))) t))))
+ (lambda (u)
+ (math-from-radians-2
+ (math-div 1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-sub 1 (math-sqr u))))) t)))
(put 'calcFunc-arccos\' 'math-derivative-1
- (function (lambda (u)
- (math-from-radians-2
- (math-div -1 (math-normalize
- (list 'calcFunc-sqrt
- (math-sub 1 (math-sqr u))))) t))))
+ (lambda (u)
+ (math-from-radians-2
+ (math-div -1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-sub 1 (math-sqr u))))) t)))
(put 'calcFunc-arctan\' 'math-derivative-1
- (function (lambda (u) (math-from-radians-2
- (math-div 1 (math-add 1 (math-sqr u))) t))))
+ (lambda (u) (math-from-radians-2
+ (math-div 1 (math-add 1 (math-sqr u))) t)))
(put 'calcFunc-sinh\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-cosh u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-cosh u))))
(put 'calcFunc-cosh\' 'math-derivative-1
- (function (lambda (u) (math-normalize (list 'calcFunc-sinh u)))))
+ (lambda (u) (math-normalize (list 'calcFunc-sinh u))))
(put 'calcFunc-tanh\' 'math-derivative-1
- (function (lambda (u) (math-sqr
- (math-normalize
- (list 'calcFunc-sech u))))))
+ (lambda (u) (math-sqr
+ (math-normalize
+ (list 'calcFunc-sech u)))))
(put 'calcFunc-sech\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-mul
- (math-normalize (list 'calcFunc-sech u))
- (math-normalize (list 'calcFunc-tanh u)))))))
+ (lambda (u) (math-neg
+ (math-mul
+ (math-normalize (list 'calcFunc-sech u))
+ (math-normalize (list 'calcFunc-tanh u))))))
(put 'calcFunc-csch\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-mul
- (math-normalize (list 'calcFunc-csch u))
- (math-normalize (list 'calcFunc-coth u)))))))
+ (lambda (u) (math-neg
+ (math-mul
+ (math-normalize (list 'calcFunc-csch u))
+ (math-normalize (list 'calcFunc-coth u))))))
(put 'calcFunc-coth\' 'math-derivative-1
- (function (lambda (u) (math-neg
- (math-sqr
- (math-normalize
- (list 'calcFunc-csch u)))))))
+ (lambda (u) (math-neg
+ (math-sqr
+ (math-normalize
+ (list 'calcFunc-csch u))))))
(put 'calcFunc-arcsinh\' 'math-derivative-1
- (function (lambda (u)
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-add (math-sqr u) 1)))))))
+ (lambda (u)
+ (math-div 1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-add (math-sqr u) 1))))))
(put 'calcFunc-arccosh\' 'math-derivative-1
- (function (lambda (u)
- (math-div 1 (math-normalize
- (list 'calcFunc-sqrt
- (math-add (math-sqr u) -1)))))))
+ (lambda (u)
+ (math-div 1 (math-normalize
+ (list 'calcFunc-sqrt
+ (math-add (math-sqr u) -1))))))
(put 'calcFunc-arctanh\' 'math-derivative-1
- (function (lambda (u) (math-div 1 (math-sub 1 (math-sqr u))))))
+ (lambda (u) (math-div 1 (math-sub 1 (math-sqr u)))))
(put 'calcFunc-bern\'2 'math-derivative-2
- (function (lambda (n x)
- (math-mul n (list 'calcFunc-bern (math-add n -1) x)))))
+ (lambda (n x)
+ (math-mul n (list 'calcFunc-bern (math-add n -1) x))))
(put 'calcFunc-euler\'2 'math-derivative-2
- (function (lambda (n x)
- (math-mul n (list 'calcFunc-euler (math-add n -1) x)))))
+ (lambda (n x)
+ (math-mul n (list 'calcFunc-euler (math-add n -1) x))))
(put 'calcFunc-gammag\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x 1))))
+ (lambda (a x) (math-deriv-gamma a x 1)))
(put 'calcFunc-gammaG\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x -1))))
+ (lambda (a x) (math-deriv-gamma a x -1)))
(put 'calcFunc-gammaP\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x
- (math-div
- 1 (math-normalize
- (list 'calcFunc-gamma
- a)))))))
+ (lambda (a x) (math-deriv-gamma a x
+ (math-div
+ 1 (math-normalize
+ (list 'calcFunc-gamma
+ a))))))
(put 'calcFunc-gammaQ\'2 'math-derivative-2
- (function (lambda (a x) (math-deriv-gamma a x
- (math-div
- -1 (math-normalize
- (list 'calcFunc-gamma
- a)))))))
+ (lambda (a x) (math-deriv-gamma a x
+ (math-div
+ -1 (math-normalize
+ (list 'calcFunc-gamma
+ a))))))
(defun math-deriv-gamma (a x scale)
(math-mul scale
@@ -533,13 +537,13 @@
(list 'calcFunc-exp (math-neg x)))))
(put 'calcFunc-betaB\' 'math-derivative-3
- (function (lambda (x a b) (math-deriv-beta x a b 1))))
+ (lambda (x a b) (math-deriv-beta x a b 1)))
(put 'calcFunc-betaI\' 'math-derivative-3
- (function (lambda (x a b) (math-deriv-beta x a b
- (math-div
- 1 (list 'calcFunc-beta
- a b))))))
+ (lambda (x a b) (math-deriv-beta x a b
+ (math-div
+ 1 (list 'calcFunc-beta
+ a b)))))
(defun math-deriv-beta (x a b scale)
(math-mul (math-mul (math-pow x (math-add a -1))
@@ -547,101 +551,96 @@
scale))
(put 'calcFunc-erf\' 'math-derivative-1
- (function (lambda (x) (math-div 2
- (math-mul (list 'calcFunc-exp
- (math-sqr x))
- (if calc-symbolic-mode
- '(calcFunc-sqrt
- (var pi var-pi))
- (math-sqrt-pi)))))))
+ (lambda (x) (math-div 2
+ (math-mul (list 'calcFunc-exp
+ (math-sqr x))
+ (if calc-symbolic-mode
+ '(calcFunc-sqrt
+ (var pi var-pi))
+ (math-sqrt-pi))))))
(put 'calcFunc-erfc\' 'math-derivative-1
- (function (lambda (x) (math-div -2
- (math-mul (list 'calcFunc-exp
- (math-sqr x))
- (if calc-symbolic-mode
- '(calcFunc-sqrt
- (var pi var-pi))
- (math-sqrt-pi)))))))
+ (lambda (x) (math-div -2
+ (math-mul (list 'calcFunc-exp
+ (math-sqr x))
+ (if calc-symbolic-mode
+ '(calcFunc-sqrt
+ (var pi var-pi))
+ (math-sqrt-pi))))))
(put 'calcFunc-besJ\'2 'math-derivative-2
- (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
- (math-add v -1)
- z)
- (list 'calcFunc-besJ
- (math-add v 1)
- z))
- 2))))
+ (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
+ (math-add v -1)
+ z)
+ (list 'calcFunc-besJ
+ (math-add v 1)
+ z))
+ 2)))
(put 'calcFunc-besY\'2 'math-derivative-2
- (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
- (math-add v -1)
- z)
- (list 'calcFunc-besY
- (math-add v 1)
- z))
- 2))))
+ (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
+ (math-add v -1)
+ z)
+ (list 'calcFunc-besY
+ (math-add v 1)
+ z))
+ 2)))
(put 'calcFunc-sum 'math-derivative-n
- (function
- (lambda (expr)
- (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
- (throw 'math-deriv nil)
- (cons 'calcFunc-sum
- (cons (math-derivative (nth 1 expr))
- (cdr (cdr expr))))))))
+ (lambda (expr)
+ (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
+ (throw 'math-deriv nil)
+ (cons 'calcFunc-sum
+ (cons (math-derivative (nth 1 expr))
+ (cdr (cdr expr)))))))
(put 'calcFunc-prod 'math-derivative-n
- (function
- (lambda (expr)
- (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
- (throw 'math-deriv nil)
- (math-mul expr
- (cons 'calcFunc-sum
- (cons (math-div (math-derivative (nth 1 expr))
- (nth 1 expr))
- (cdr (cdr expr)))))))))
+ (lambda (expr)
+ (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
+ (throw 'math-deriv nil)
+ (math-mul expr
+ (cons 'calcFunc-sum
+ (cons (math-div (math-derivative (nth 1 expr))
+ (nth 1 expr))
+ (cdr (cdr expr))))))))
(put 'calcFunc-integ 'math-derivative-n
- (function
- (lambda (expr)
- (if (= (length expr) 3)
- (if (equal (nth 2 expr) math-deriv-var)
- (nth 1 expr)
- (math-normalize
- (list 'calcFunc-integ
- (math-derivative (nth 1 expr))
- (nth 2 expr))))
- (if (= (length expr) 5)
- (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
- (nth 3 expr)))
- (upper (math-expr-subst (nth 1 expr) (nth 2 expr)
- (nth 4 expr))))
- (math-add (math-sub (math-mul upper
- (math-derivative (nth 4 expr)))
- (math-mul lower
- (math-derivative (nth 3 expr))))
- (if (equal (nth 2 expr) math-deriv-var)
- 0
- (math-normalize
- (list 'calcFunc-integ
- (math-derivative (nth 1 expr)) (nth 2 expr)
- (nth 3 expr) (nth 4 expr)))))))))))
+ (lambda (expr)
+ (if (= (length expr) 3)
+ (if (equal (nth 2 expr) math-deriv-var)
+ (nth 1 expr)
+ (math-normalize
+ (list 'calcFunc-integ
+ (math-derivative (nth 1 expr))
+ (nth 2 expr))))
+ (if (= (length expr) 5)
+ (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
+ (nth 3 expr)))
+ (upper (math-expr-subst (nth 1 expr) (nth 2 expr)
+ (nth 4 expr))))
+ (math-add (math-sub (math-mul upper
+ (math-derivative (nth 4 expr)))
+ (math-mul lower
+ (math-derivative (nth 3 expr))))
+ (if (equal (nth 2 expr) math-deriv-var)
+ 0
+ (math-normalize
+ (list 'calcFunc-integ
+ (math-derivative (nth 1 expr)) (nth 2 expr)
+ (nth 3 expr) (nth 4 expr))))))))))
(put 'calcFunc-if 'math-derivative-n
- (function
- (lambda (expr)
- (and (= (length expr) 4)
- (list 'calcFunc-if (nth 1 expr)
- (math-derivative (nth 2 expr))
- (math-derivative (nth 3 expr)))))))
+ (lambda (expr)
+ (and (= (length expr) 4)
+ (list 'calcFunc-if (nth 1 expr)
+ (math-derivative (nth 2 expr))
+ (math-derivative (nth 3 expr))))))
(put 'calcFunc-subscr 'math-derivative-n
- (function
- (lambda (expr)
- (and (= (length expr) 3)
- (list 'calcFunc-subscr (nth 1 expr)
- (math-derivative (nth 2 expr)))))))
+ (lambda (expr)
+ (and (= (length expr) 3)
+ (list 'calcFunc-subscr (nth 1 expr)
+ (math-derivative (nth 2 expr))))))
(defvar math-integ-var '(var X ---))
@@ -1011,11 +1010,10 @@
res '(calcFunc-integsubst)))
(and (memq (length part) '(3 4 5))
(let ((parts (mapcar
- (function
- (lambda (x)
- (math-expr-subst
- x (nth 2 part)
- math-integ-var)))
+ (lambda (x)
+ (math-expr-subst
+ x (nth 2 part)
+ math-integ-var))
(cdr part))))
(math-integrate-by-substitution
expr (car parts) t
@@ -1079,8 +1077,9 @@
;; math-integ-try-substitutions.
(defvar math-integ-expr)
-(defun math-do-integral-methods (math-integ-expr)
- (let ((math-so-far math-integ-var-list-list)
+(defun math-do-integral-methods (integ-expr)
+ (let ((math-integ-expr integ-expr)
+ (math-so-far math-integ-var-list-list)
rat-in)
;; Integration by substitution, for various likely sub-expressions.
@@ -1195,10 +1194,11 @@
(defvar math-good-parts)
-(defun math-integ-try-parts (expr &optional math-good-parts)
+(defun math-integ-try-parts (expr &optional good-parts)
;; Integration by parts:
;; integ(f(x) g(x),x) = f(x) h(x) - integ(h(x) f'(x),x)
;; where h(x) = integ(g(x),x).
+ (let ((math-good-parts good-parts))
(or (let ((exp (calcFunc-expand expr)))
(and (not (equal exp expr))
(math-integral exp)))
@@ -1219,14 +1219,14 @@
(and (eq (car expr) '^)
(math-integrate-by-parts (math-pow (nth 1 expr)
(math-sub (nth 2 expr) 1))
- (nth 1 expr)))))
+ (nth 1 expr))))))
(defun math-integrate-by-parts (u vprime)
(let ((math-integ-level (if (or math-good-parts
(math-polynomial-p u math-integ-var))
math-integ-level
(1- math-integ-level)))
- (math-doing-parts t)
+ ;; (math-doing-parts t) ;Unused
v temp)
(and (>= math-integ-level 0)
(unwind-protect
@@ -1510,7 +1510,7 @@
var low high)
(nth 2 (nth 2 expr))))
((eq (car-safe expr) 'vec)
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-integ x var low high)))
+ (cons 'vec (mapcar (lambda (x) (calcFunc-integ x var low high))
(cdr expr))))
(t
(let ((state (list calc-angle-mode
@@ -1532,7 +1532,7 @@
(math-any-substs t)
(math-enable-subst nil)
(math-prev-parts-v nil)
- (math-doing-parts nil)
+ ;; (math-doing-parts nil) ;Unused
(math-good-parts nil)
(res
(if trace-buffer
@@ -1883,7 +1883,10 @@
(defvar calc-high)
(defvar math-var)
-(defun calcFunc-table (expr math-var &optional calc-low calc-high step)
+(defun calcFunc-table (expr var &optional low high step)
+ (let ((math-var var)
+ (calc-high high)
+ (calc-low low))
(or calc-low
(setq calc-low '(neg (var inf var-inf)) calc-high '(var inf var-inf)))
(or calc-high (setq calc-high calc-low calc-low 1))
@@ -1894,8 +1897,7 @@
(let ((known (+ (if (Math-objectp calc-low) 1 0)
(if (Math-objectp calc-high) 1 0)
(if (or (null step) (Math-objectp step)) 1 0)))
- (count '(var inf var-inf))
- vec)
+ (count '(var inf var-inf))) ;; vec
(or (= known 2) ; handy optimization
(equal calc-high '(var inf var-inf))
(progn
@@ -1906,6 +1908,7 @@
(setq count (math-trunc count)))))
(if (Math-negp count)
(setq count -1))
+ (defvar var-DUMMY)
(if (integerp count)
(let ((var-DUMMY nil)
(vec math-tabulate-initial)
@@ -1939,7 +1942,7 @@
(and (not (and (equal calc-low '(neg (var inf var-inf)))
(equal calc-high '(var inf var-inf))))
(list calc-low calc-high))
- (and step (list step))))))
+ (and step (list step)))))))
(defun math-scan-for-limits (x)
(cond ((Math-primp x))
@@ -1951,8 +1954,10 @@
(high-val (math-solve-for (nth 2 x) (1- (length (nth 1 x)))
math-var nil))
temp)
- (and low-val (math-realp low-val)
- high-val (math-realp high-val))
+ ;; FIXME: The below is a no-op, but I suspect its result
+ ;; was meant to be used, tho I don't know what for.
+ ;; (and low-val (math-realp low-val)
+ ;; high-val (math-realp high-val))
(and (Math-lessp high-val low-val)
(setq temp low-val low-val high-val high-val temp))
(setq calc-low (math-max calc-low (math-ceiling low-val))
@@ -2361,8 +2366,11 @@
(defvar math-try-solve-sign)
(defun math-try-solve-for
- (math-solve-lhs math-solve-rhs &optional math-try-solve-sign no-poly)
- (let (math-t1 math-t2 math-t3)
+ (solve-lhs solve-rhs &optional try-solve-sign no-poly)
+ (let ((math-solve-lhs solve-lhs)
+ (math-solve-rhs solve-rhs)
+ (math-try-solve-sign try-solve-sign)
+ math-t1 math-t2 math-t3)
(cond ((equal math-solve-lhs math-solve-var)
(setq math-solve-sign math-try-solve-sign)
(if (eq math-solve-full 'all)
@@ -2721,32 +2729,34 @@
(cons 'vec d)
(math-reject-arg expr "Expected a polynomial"))))
-(defun math-decompose-poly (math-solve-lhs math-solve-var degree sub-rhs)
- (let ((math-solve-rhs (or sub-rhs 1))
+(defun math-decompose-poly (solve-lhs solve-var degree sub-rhs)
+ (let ((math-solve-lhs solve-lhs)
+ (math-solve-var solve-var)
+ (math-solve-rhs (or sub-rhs 1))
math-t1 math-t2 math-t3)
(setq math-t2 (math-polynomial-base
math-solve-lhs
- (function
- (lambda (math-solve-b)
- (let ((math-poly-neg-powers '(1))
- (math-poly-mult-powers nil)
- (math-poly-frac-powers 1)
- (math-poly-exp-base t))
- (and (not (equal math-solve-b math-solve-lhs))
- (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
- (setq math-t3 '(1 0) math-t2 1
- math-t1 (math-is-polynomial math-solve-lhs
- math-solve-b 50))
- (if (and (equal math-poly-neg-powers '(1))
- (memq math-poly-mult-powers '(nil 1))
- (eq math-poly-frac-powers 1)
- sub-rhs)
- (setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs)
- (cdr math-t1)))
- (math-solve-poly-funny-powers sub-rhs))
- (math-solve-crunch-poly degree)
- (or (math-expr-contains math-solve-b math-solve-var)
- (math-expr-contains (car math-t3) math-solve-var))))))))
+ (lambda (solve-b)
+ (let ((math-solve-b solve-b)
+ (math-poly-neg-powers '(1))
+ (math-poly-mult-powers nil)
+ (math-poly-frac-powers 1)
+ (math-poly-exp-base t))
+ (and (not (equal math-solve-b math-solve-lhs))
+ (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
+ (setq math-t3 '(1 0) math-t2 1
+ math-t1 (math-is-polynomial math-solve-lhs
+ math-solve-b 50))
+ (if (and (equal math-poly-neg-powers '(1))
+ (memq math-poly-mult-powers '(nil 1))
+ (eq math-poly-frac-powers 1)
+ sub-rhs)
+ (setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs)
+ (cdr math-t1)))
+ (math-solve-poly-funny-powers sub-rhs))
+ (math-solve-crunch-poly degree)
+ (or (math-expr-contains math-solve-b math-solve-var)
+ (math-expr-contains (car math-t3) math-solve-var)))))))
(if math-t2
(list (math-pow math-t2 (car math-t3))
(cons 'vec math-t1)
@@ -2964,7 +2974,7 @@
(math-poly-integer-root (car roots))
(setq roots (cdr roots)))
(list math-int-factors (nreverse math-int-coefs) math-int-scale))
- (let ((vec nil) res)
+ (let ((vec nil)) ;; res
(while roots
(let ((root (car roots))
(math-solve-full (and math-solve-full 'all)))
@@ -3109,7 +3119,7 @@
(iters 0)
(m (1- (length p)))
(try-newt (not polish))
- (tried-newt nil)
+ ;; (tried-newt nil)
b d f x1 dx dxold)
(while
(and (or (< (setq iters (1+ iters)) 50)
@@ -3146,7 +3156,7 @@
(math-lessp (math-abs-approx dx)
(calcFunc-scf (math-abs-approx x) -3)))
(let ((newt (math-poly-newton-root p x1 7)))
- (setq tried-newt t
+ (setq ;; tried-newt t
try-newt nil)
(if (math-zerop (cdr newt))
(setq x (car newt) x1 x)
@@ -3160,7 +3170,8 @@
(math-nearly-equal x x1))))
(let ((cdx (math-abs-approx dx)))
(setq x x1
- tried-newt nil)
+ ;; tried-newt nil
+ )
(prog1
(or (<= iters 6)
(math-lessp cdx dxold)
@@ -3227,7 +3238,9 @@
;; and math-solve-system-rec, but is used by math-solve-system-subst.
(defvar math-solve-simplifying)
-(defun math-solve-system (exprs math-solve-vars math-solve-full)
+(defun math-solve-system (exprs solve-vars solve-full)
+ (let ((math-solve-vars solve-vars)
+ (math-solve-full solve-full))
(setq exprs (mapcar 'list (if (Math-vectorp exprs)
(cdr exprs)
(list exprs)))
@@ -3237,18 +3250,18 @@
(or (let ((math-solve-simplifying nil))
(math-solve-system-rec exprs math-solve-vars nil))
(let ((math-solve-simplifying t))
- (math-solve-system-rec exprs math-solve-vars nil))))
+ (math-solve-system-rec exprs math-solve-vars nil)))))
-;;; The following backtracking solver works by choosing a variable
-;;; and equation, and trying to solve the equation for the variable.
-;;; If it succeeds it calls itself recursively with that variable and
-;;; equation removed from their respective lists, and with the solution
-;;; added to solns as well as being substituted into all existing
-;;; equations. The algorithm terminates when any solution path
-;;; manages to remove all the variables from var-list.
+;; The following backtracking solver works by choosing a variable
+;; and equation, and trying to solve the equation for the variable.
+;; If it succeeds it calls itself recursively with that variable and
+;; equation removed from their respective lists, and with the solution
+;; added to solns as well as being substituted into all existing
+;; equations. The algorithm terminates when any solution path
+;; manages to remove all the variables from `var-list'.
-;;; To support calcFunc-roots, entries in eqn-list and solns are
-;;; actually lists of equations.
+;; To support calcFunc-roots, entries in eqn-list and solns are
+;; actually lists of equations.
;; The variables math-solve-system-res and math-solve-system-vv are
;; local to math-solve-system-rec, but are used by math-solve-system-subst.
@@ -3306,12 +3319,11 @@
(delq (car v) (copy-sequence var-list))
(let ((math-solve-simplifying nil)
(s (mapcar
- (function
- (lambda (x)
- (cons
- (car x)
- (math-solve-system-subst
- (cdr x)))))
+ (lambda (x)
+ (cons
+ (car x)
+ (math-solve-system-subst
+ (cdr x))))
solns)))
(if elim
s
@@ -3327,35 +3339,33 @@
;; Eliminated all variables, so now put solution into the proper format.
(setq solns (sort solns
- (function
- (lambda (x y)
- (not (memq (car x) (memq (car y) math-solve-vars)))))))
+ (lambda (x y)
+ (not (memq (car x) (memq (car y) math-solve-vars))))))
(if (eq math-solve-full 'all)
(math-transpose
(math-normalize
(cons 'vec
(if solns
- (mapcar (function (lambda (x) (cons 'vec (cdr x)))) solns)
- (mapcar (function (lambda (x) (cons 'vec x))) eqn-list)))))
+ (mapcar (lambda (x) (cons 'vec (cdr x))) solns)
+ (mapcar (lambda (x) (cons 'vec x)) eqn-list)))))
(math-normalize
(cons 'vec
(if solns
- (mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns)
- (mapcar 'car eqn-list)))))))
+ (mapcar (lambda (x) (cons 'calcFunc-eq x)) solns)
+ (mapcar #'car eqn-list)))))))
(defun math-solve-system-subst (x) ; uses "res" and "v"
(let ((accum nil)
(res2 math-solve-system-res))
(while x
(setq accum (nconc accum
- (mapcar (function
- (lambda (r)
- (if math-solve-simplifying
- (math-simplify
- (math-expr-subst
- (car x) math-solve-system-vv r))
- (math-expr-subst
- (car x) math-solve-system-vv r))))
+ (mapcar (lambda (r)
+ (if math-solve-simplifying
+ (math-simplify
+ (math-expr-subst
+ (car x) math-solve-system-vv r))
+ (math-expr-subst
+ (car x) math-solve-system-vv r)))
(car res2)))
x (cdr x)
res2 (cdr res2)))
@@ -3437,10 +3447,12 @@
(if (memq (car expr) '(* /))
(math-looks-evenp (nth 1 expr)))))
-(defun math-solve-for (lhs rhs math-solve-var math-solve-full &optional sign)
- (if (math-expr-contains rhs math-solve-var)
- (math-solve-for (math-sub lhs rhs) 0 math-solve-var math-solve-full)
- (and (math-expr-contains lhs math-solve-var)
+(defun math-solve-for (lhs rhs solve-var solve-full &optional sign)
+ (let ((math-solve-var solve-var)
+ (math-solve-full solve-full))
+ (if (math-expr-contains rhs solve-var)
+ (math-solve-for (math-sub lhs rhs) 0 solve-var solve-full)
+ (and (math-expr-contains lhs solve-var)
(math-with-extra-prec 1
(let* ((math-poly-base-variable math-solve-var)
(res (math-try-solve-for lhs rhs sign)))
@@ -3449,11 +3461,10 @@
(let ((old-len (length res))
new-len)
(setq res (delq nil
- (mapcar (function
- (lambda (x)
- (and (not (memq (car-safe x)
- '(cplx polar)))
- x)))
+ (mapcar (lambda (x)
+ (and (not (memq (car-safe x)
+ '(cplx polar)))
+ x))
res))
new-len (length res))
(if (< new-len old-len)
@@ -3462,7 +3473,7 @@
(format
"*Omitted %d complex solutions"
(- old-len new-len)))))))
- res)))))
+ res))))))
(defun math-solve-eqn (expr var full)
(if (memq (car-safe expr) '(calcFunc-neq calcFunc-lt calcFunc-gt
@@ -3523,119 +3534,119 @@
(put 'calcFunc-inv 'math-inverse
- (function (lambda (x) (math-div 1 x))))
+ (lambda (x) (math-div 1 x)))
(put 'calcFunc-inv 'math-inverse-sign -1)
(put 'calcFunc-sqrt 'math-inverse
- (function (lambda (x) (math-sqr x))))
+ (lambda (x) (math-sqr x)))
(put 'calcFunc-conj 'math-inverse
- (function (lambda (x) (list 'calcFunc-conj x))))
+ (lambda (x) (list 'calcFunc-conj x)))
(put 'calcFunc-abs 'math-inverse
- (function (lambda (x) (math-solve-get-sign x))))
+ (lambda (x) (math-solve-get-sign x)))
(put 'calcFunc-deg 'math-inverse
- (function (lambda (x) (list 'calcFunc-rad x))))
+ (lambda (x) (list 'calcFunc-rad x)))
(put 'calcFunc-deg 'math-inverse-sign 1)
(put 'calcFunc-rad 'math-inverse
- (function (lambda (x) (list 'calcFunc-deg x))))
+ (lambda (x) (list 'calcFunc-deg x)))
(put 'calcFunc-rad 'math-inverse-sign 1)
(put 'calcFunc-ln 'math-inverse
- (function (lambda (x) (list 'calcFunc-exp x))))
+ (lambda (x) (list 'calcFunc-exp x)))
(put 'calcFunc-ln 'math-inverse-sign 1)
(put 'calcFunc-log10 'math-inverse
- (function (lambda (x) (list 'calcFunc-exp10 x))))
+ (lambda (x) (list 'calcFunc-exp10 x)))
(put 'calcFunc-log10 'math-inverse-sign 1)
(put 'calcFunc-lnp1 'math-inverse
- (function (lambda (x) (list 'calcFunc-expm1 x))))
+ (lambda (x) (list 'calcFunc-expm1 x)))
(put 'calcFunc-lnp1 'math-inverse-sign 1)
(put 'calcFunc-exp 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
- (math-mul 2
- (math-mul '(var pi var-pi)
- (math-solve-get-int
- '(var i var-i))))))))
+ (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
+ (math-mul 2
+ (math-mul '(var pi var-pi)
+ (math-solve-get-int
+ '(var i var-i)))))))
(put 'calcFunc-exp 'math-inverse-sign 1)
(put 'calcFunc-expm1 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
- (math-mul 2
- (math-mul '(var pi var-pi)
- (math-solve-get-int
- '(var i var-i))))))))
+ (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
+ (math-mul 2
+ (math-mul '(var pi var-pi)
+ (math-solve-get-int
+ '(var i var-i)))))))
(put 'calcFunc-expm1 'math-inverse-sign 1)
(put 'calcFunc-sin 'math-inverse
- (function (lambda (x) (let ((n (math-solve-get-int 1)))
- (math-add (math-mul (math-normalize
- (list 'calcFunc-arcsin x))
- (math-pow -1 n))
- (math-mul (math-half-circle t)
- n))))))
+ (lambda (x) (let ((n (math-solve-get-int 1)))
+ (math-add (math-mul (math-normalize
+ (list 'calcFunc-arcsin x))
+ (math-pow -1 n))
+ (math-mul (math-half-circle t)
+ n)))))
(put 'calcFunc-cos 'math-inverse
- (function (lambda (x) (math-add (math-solve-get-sign
- (math-normalize
- (list 'calcFunc-arccos x)))
- (math-solve-get-int
- (math-full-circle t))))))
+ (lambda (x) (math-add (math-solve-get-sign
+ (math-normalize
+ (list 'calcFunc-arccos x)))
+ (math-solve-get-int
+ (math-full-circle t)))))
(put 'calcFunc-tan 'math-inverse
- (function (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
- (math-solve-get-int
- (math-half-circle t))))))
+ (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
+ (math-solve-get-int
+ (math-half-circle t)))))
(put 'calcFunc-arcsin 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-sin x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-sin x))))
(put 'calcFunc-arccos 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-cos x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-cos x))))
(put 'calcFunc-arctan 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-tan x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-tan x))))
(put 'calcFunc-sinh 'math-inverse
- (function (lambda (x) (let ((n (math-solve-get-int 1)))
- (math-add (math-mul (math-normalize
- (list 'calcFunc-arcsinh x))
- (math-pow -1 n))
- (math-mul (math-half-circle t)
- (math-mul
- '(var i var-i)
- n)))))))
+ (lambda (x) (let ((n (math-solve-get-int 1)))
+ (math-add (math-mul (math-normalize
+ (list 'calcFunc-arcsinh x))
+ (math-pow -1 n))
+ (math-mul (math-half-circle t)
+ (math-mul
+ '(var i var-i)
+ n))))))
(put 'calcFunc-sinh 'math-inverse-sign 1)
(put 'calcFunc-cosh 'math-inverse
- (function (lambda (x) (math-add (math-solve-get-sign
- (math-normalize
- (list 'calcFunc-arccosh x)))
- (math-mul (math-full-circle t)
- (math-solve-get-int
- '(var i var-i)))))))
+ (lambda (x) (math-add (math-solve-get-sign
+ (math-normalize
+ (list 'calcFunc-arccosh x)))
+ (math-mul (math-full-circle t)
+ (math-solve-get-int
+ '(var i var-i))))))
(put 'calcFunc-tanh 'math-inverse
- (function (lambda (x) (math-add (math-normalize
- (list 'calcFunc-arctanh x))
- (math-mul (math-half-circle t)
- (math-solve-get-int
- '(var i var-i)))))))
+ (lambda (x) (math-add (math-normalize
+ (list 'calcFunc-arctanh x))
+ (math-mul (math-half-circle t)
+ (math-solve-get-int
+ '(var i var-i))))))
(put 'calcFunc-tanh 'math-inverse-sign 1)
(put 'calcFunc-arcsinh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-sinh x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-sinh x))))
(put 'calcFunc-arcsinh 'math-inverse-sign 1)
(put 'calcFunc-arccosh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-cosh x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-cosh x))))
(put 'calcFunc-arctanh 'math-inverse
- (function (lambda (x) (math-normalize (list 'calcFunc-tanh x)))))
+ (lambda (x) (math-normalize (list 'calcFunc-tanh x))))
(put 'calcFunc-arctanh 'math-inverse-sign 1)
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index 67183fb754a..fdcde95dae7 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -1,4 +1,4 @@
-;;; calcalg3.el --- more algebraic functions for Calc
+;;; calcalg3.el --- more algebraic functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -120,18 +120,24 @@
(defvar calc-curve-fit-history nil
"History for calc-curve-fit.")
-(defun calc-curve-fit (arg &optional calc-curve-model
- calc-curve-coefnames calc-curve-varnames)
+(defvar calc-graph-no-auto-view)
+(defvar calc-fit-to-trail nil)
+
+(defun calc-curve-fit (arg &optional curve-model
+ curve-coefnames curve-varnames)
(interactive "P")
(calc-slow-wrapper
(setq calc-aborted-prefix nil)
- (let ((func (if (calc-is-inverse) 'calcFunc-xfit
+ (let ((calc-curve-model curve-model)
+ (calc-curve-coefnames curve-coefnames)
+ (calc-curve-varnames curve-varnames)
+ (func (if (calc-is-inverse) 'calcFunc-xfit
(if (calc-is-hyperbolic) 'calcFunc-efit
'calcFunc-fit)))
key (which 0)
(nonlinear nil)
(plot nil)
- n calc-curve-nvars temp data
+ n calc-curve-nvars data ;; temp
(homog nil)
(msgs '( "(Press ? for help)"
"1 = linear or multilinear"
@@ -321,7 +327,7 @@
(calc-get-fit-variables 1 (1- (length calc-curve-coefnames))
(and homog 1)))
((memq key '(?\$ ?\' ?u ?U))
- (let* ((defvars nil)
+ (let* (;; (defvars nil)
(record-entry nil))
(if (eq key ?\')
(let* ((calc-dollar-values calc-arg-values)
@@ -470,17 +476,19 @@
(setq defv (calc-invent-independent-variables nv)))
(or defc
(setq defc (calc-invent-parameter-variables nc defv)))
- (let ((vars (read-string (format "Fitting variables (default %s; %s): "
- (mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
- defv)
- ",")
- (mapconcat 'symbol-name
- (mapcar (function (lambda (v)
- (nth 1 v)))
- defc)
- ","))))
+ (let ((vars (read-string (format-prompt
+ "Fitting variables"
+ (format "%s; %s"
+ (mapconcat 'symbol-name
+ (mapcar (lambda (v)
+ (nth 1 v))
+ defv)
+ ",")
+ (mapconcat 'symbol-name
+ (mapcar (lambda (v)
+ (nth 1 v))
+ defc)
+ ",")))))
(coefs nil))
(setq vars (if (string-match "\\[" vars)
(math-read-expr vars)
@@ -706,7 +714,7 @@
"*Unable to find a sign change in this interval"))))
;;; "rtbis" (but we should be using Brent's method)
-(defun math-bisect-root (expr low vlow high vhigh)
+(defun math-bisect-root (expr low _vlow high vhigh)
(let ((step (math-sub-float high low))
(pos (Math-posp vhigh))
var-DUMMY
@@ -724,7 +732,8 @@
(setq high mid
vhigh vmid)
(setq low mid
- vlow vmid)))
+ ;; vlow vmid
+ )))
(list 'vec mid vmid)))
;;; "mnewt"
@@ -756,7 +765,8 @@
(list 'vec next expr-val))))
-(defun math-find-root (expr var guess math-root-widen)
+(defun math-find-root (expr var guess root-widen)
+ (let ((math-root-widen root-widen))
(if (eq (car-safe expr) 'vec)
(let ((n (1- (length expr)))
(calc-symbolic-mode nil)
@@ -869,7 +879,7 @@
(not (Math-numberp vlow))
(not (Math-numberp vhigh)))
(math-search-root expr deriv low vlow high vhigh)
- (math-bisect-root expr low vlow high vhigh))))))))))
+ (math-bisect-root expr low vlow high vhigh)))))))))))
(defun calcFunc-root (expr var guess)
(math-find-root expr var guess nil))
@@ -1017,7 +1027,7 @@
math-min-or-max))))))
;;; "brent"
-(defun math-brent-min (expr prec a va x vx b vb)
+(defun math-brent-min (expr prec a _va x vx b _vb)
(let ((iters (+ 20 (* 5 prec)))
(w x)
(vw vx)
@@ -1179,7 +1189,7 @@
(list 'calcFunc-mrow '(var line-p line-p) (1+ m)))))
(math-evaluate-expr expr)))
-(defun math-line-min (f1dim line-p line-xi n prec)
+(defun math-line-min (f1dim line-p line-xi _n prec)
(let* ((var-DUMMY nil)
(expr (math-evaluate-expr f1dim))
(params (math-widen-min expr '(float 0 0) '(float 1 0)))
@@ -1193,7 +1203,7 @@
(n 0)
(var-DUMMY nil)
(isvec (math-vectorp var))
- g guesses)
+ guesses) ;; g
(or (math-vectorp var)
(setq var (list 'vec var)))
(or (math-vectorp guess)
@@ -1326,7 +1336,7 @@
(or (> (length (nth 1 data)) 2)
(math-reject-arg data "*Too few data points"))
(if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-polint data x)))
+ (cons 'vec (mapcar (lambda (x) (calcFunc-polint data x))
(cdr x)))
(or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
(math-with-extra-prec 2
@@ -1342,7 +1352,7 @@
(or (> (length (nth 1 data)) 2)
(math-reject-arg data "*Too few data points"))
(if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
- (cons 'vec (mapcar (function (lambda (x) (calcFunc-ratint data x)))
+ (cons 'vec (mapcar (lambda (x) (calcFunc-ratint data x))
(cdr x)))
(or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
(math-with-extra-prec 2
@@ -1491,7 +1501,8 @@
(defun math-ninteg-midpoint (expr lo hi mode) ; uses "math-ninteg-temp"
(if (eq mode 'inf)
- (let ((math-infinite-mode t) temp)
+ (let (;; (math-infinite-mode t) ;Unused!
+ temp)
(setq temp (math-div 1 lo)
lo (math-div 1 hi)
hi temp)))
@@ -1545,7 +1556,6 @@
(setq math-dummy-counter (1+ math-dummy-counter))))
(defvar math-in-fit 0)
-(defvar calc-fit-to-trail nil)
(defun calcFunc-fit (expr vars &optional coefs data)
(let ((math-in-fit 10))
@@ -1571,6 +1581,7 @@
(defvar math-fit-new-coefs)
(defun math-general-fit (expr vars coefs data mode)
+ (defvar var-YVAL) (defvar var-YVALX)
(let ((calc-simplify-mode nil)
(math-dummy-counter math-dummy-counter)
(math-in-fit 1)
@@ -1589,7 +1600,7 @@
(weights nil)
(var-YVAL nil) (var-YVALX nil)
covar beta
- n nn m mm v dummy p)
+ n m mm v dummy p) ;; nn
;; Validate and parse arguments.
(or data
@@ -1685,7 +1696,7 @@
(isigsq 1)
(xvals (make-vector mm 0))
(i 0)
- j k xval yval sigmasqr wt covj covjk covk betaj lud)
+ j k xval yval sigmasqr wt covj covjk covk betaj) ;; lud
(while (<= (setq i (1+ i)) n)
;; Assign various independent variables for this data point.
@@ -1899,8 +1910,8 @@
(while p
(setq vars (delq (assoc (car-safe p) vars) vars)
p (cdr p)))
- (sort (mapcar 'car vars)
- (function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))))
+ (sort (mapcar #'car vars)
+ (lambda (x y) (string< (nth 1 x) (nth 1 y))))))
;; The variables math-all-vars-vars (the vars for math-all-vars) and
;; math-all-vars-found are local to math-all-vars-in, but are used by
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 0367c537b5a..1f3ae842638 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -1018,7 +1018,8 @@
(make-string (+ w 2) ?\_))
(list 'horiz
(if (= h 1)
- "V"
+ (if (char-displayable-p ?√)
+ "√" "V")
(append (list 'vleft (1- a))
(make-list (1- h) " |")
'("\\|")))
diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el
index c8a714900dc..d6842aa7eee 100644
--- a/lisp/calc/calcsel2.el
+++ b/lisp/calc/calcsel2.el
@@ -1,4 +1,4 @@
-;;; calcsel2.el --- selection functions for Calc
+;;; calcsel2.el --- selection functions for Calc -*- lexical-binding:t -*-
;; Copyright (C) 1990-1993, 2001-2020 Free Software Foundation, Inc.
@@ -34,6 +34,7 @@
;; The variable calc-sel-reselect is local to the methods below,
;; but is used by some functions in calc-sel.el which are called
;; by the functions below.
+(defvar calc-sel-reselect)
(defun calc-commute-left (arg)
(interactive "p")
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 6996990814d..cd92f992689 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -858,13 +858,11 @@ The result should not exceed the screen width."
"Convert the given STR to a number, according to the value of
`calculator-input-radix'."
(if calculator-input-radix
- (string-to-number str (cadr (assq calculator-input-radix
- '((bin 2) (oct 8) (hex 16)))))
- (let* ((str (replace-regexp-in-string
- "\\.\\([^0-9].*\\)?$" ".0\\1" str))
- (str (replace-regexp-in-string
- "[eE][+-]?\\([^0-9].*\\)?$" "e0\\1" str)))
- (string-to-number str))))
+ (string-to-number str (cadr (assq calculator-input-radix
+ '((bin 2) (oct 8) (hex 16)))))
+ ;; Allow entry of "1.e3".
+ (let ((str (replace-regexp-in-string (rx "." (any "eE")) "e" str)))
+ (float (string-to-number str)))))
(defun calculator-push-curnum ()
"Push the numeric value of the displayed number to the stack."
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index b6bb040dd54..4bfdf3a6cf6 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" "Mashíyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il"
- "Sharaf" "Sulṭán" "Mulk" "‘Alá’"]
+ "Asmá’" "‘Izzat" "Mas͟híyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il"
+ "S͟haraf" "Sulṭán" "Mulk" "‘Alá’"]
"Array of the month names in the Bahá’í calendar.")
(defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844))
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index 3db12e668ab..05768e10c01 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -350,17 +350,31 @@ If the locale never uses daylight saving time, set this to 0."
:group 'calendar-dst)
(defcustom calendar-standard-time-zone-name
- (or (nth 2 calendar-current-time-zone-cache) "EST")
+ (if (eq calendar-time-zone-style 'numeric)
+ (if calendar-current-time-zone-cache
+ (format-time-string
+ "%z" 0 (* 60 (car calendar-current-time-zone-cache)))
+ "+0000")
+ (or (nth 2 calendar-current-time-zone-cache) "EST"))
"Abbreviated name of standard time zone at `calendar-location-name'.
For example, \"EST\" in New York City, \"PST\" for Los Angeles."
:type 'string
+ :version "28.1"
+ :set-after '(calendar-time-zone-style)
:group 'calendar-dst)
(defcustom calendar-daylight-time-zone-name
- (or (nth 3 calendar-current-time-zone-cache) "EDT")
+ (if (eq calendar-time-zone-style 'numeric)
+ (if calendar-current-time-zone-cache
+ (format-time-string
+ "%z" 0 (* 60 (cadr calendar-current-time-zone-cache)))
+ "+0000")
+ (or (nth 3 calendar-current-time-zone-cache) "EDT"))
"Abbreviated name of daylight saving time zone at `calendar-location-name'.
For example, \"EDT\" in New York City, \"PDT\" for Los Angeles."
:type 'string
+ :version "28.1"
+ :set-after '(calendar-time-zone-style)
:group 'calendar-dst)
(defcustom calendar-daylight-savings-starts-time
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index 1c741317803..918995d0f9b 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -1,4 +1,4 @@
-;;; cal-julian.el --- calendar functions for the Julian calendar
+;;; cal-julian.el --- calendar functions for the Julian calendar -*- lexical-binding:t -*-
;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
@@ -182,23 +182,27 @@ Echo astronomical (Julian) day number unless NOECHO is non-nil."
(calendar-astro-to-absolute daynumber))))
(or noecho (calendar-astro-print-day-number)))
-
-;; The function below is designed to be used in sexp diary entries,
-;; and may be present in users' diary files, so suppress the warning
-;; about this prefix-less dynamic variable. It's called from
-;; `diary-list-sexp-entries', which binds the variable.
-(with-suppressed-warnings ((lexical date))
- (defvar date))
-
;;;###diary-autoload
(defun diary-julian-date ()
"Julian calendar equivalent of date diary entry."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(format "Julian date: %s" (calendar-julian-date-string date)))
;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun diary-astro-day-number ()
"Astronomical (Julian) day number diary entry."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(format "Astronomical (Julian) day number at noon UTC: %s.0"
(calendar-astro-date-string date)))
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 83e7976125f..de9b1f3ff53 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -136,14 +136,13 @@
;; - whatever is passed to diary-remind
(defmacro calendar-dlet* (binders &rest body)
- "Like `let*' but using dynamic scoping."
+ "Like `dlet' but without warnings about non-prefixed var names."
(declare (indent 1) (debug let))
- `(progn
- (with-no-warnings ;Silence "lacks a prefix" warnings!
- ,@(mapcar (lambda (binder)
- `(defvar ,(if (consp binder) (car binder) binder)))
- binders))
- (let* ,binders ,@body)))
+ (let ((vars (mapcar (lambda (binder)
+ (if (consp binder) (car binder) binder))
+ binders)))
+ `(with-suppressed-warnings ((lexical ,@vars))
+ (dlet ,binders ,@body))))
;; Avoid recursive load of calendar when loading cal-menu. Yuck.
(provide 'calendar)
@@ -995,7 +994,7 @@ pre-existing calendar windows."
"Set the style of calendar and diary dates to STYLE (a symbol).
The valid styles are described in the documentation of `calendar-date-style'."
(interactive (list (intern
- (completing-read "Date style: "
+ (completing-read (format-prompt "Date style" "american")
'("american" "european" "iso") nil t
nil nil "american"))))
(or (memq style '(american european iso))
@@ -1062,6 +1061,15 @@ calendar."
:type 'boolean
:group 'holidays)
+;; fixme should have a :set that changes calendar-standard-time-zone-name etc.
+(defcustom calendar-time-zone-style 'symbolic
+ "Your preferred style for time zones.
+If 'numeric, use numeric time zones like \"+0100\".
+Otherwise, use symbolic time zones like \"CET\"."
+ :type '(choice (const numeric) (other symbolic))
+ :version "28.1"
+ :group 'calendar)
+
;;; End of user options.
(calendar-recompute-layout-variables)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 6d262088479..fbc13f59b2a 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -98,7 +98,7 @@ specifies which face attribute (e.g. `:foreground') to modify, or
that this is a face (`:face') to apply. TYPE is the type of
attribute being applied. Available TYPES (see `diary-attrtype-convert')
are: `string', `symbol', `int', `tnil', `stringtnil'."
- :type '(repeat (list (string :tag "Regular expression")
+ :type '(repeat (list (regexp :tag "Regular expression")
(integer :tag "Sub-expression")
(symbol :tag "Attribute (e.g. :foreground)")
(choice (const string :tag "A string")
@@ -1092,7 +1092,9 @@ This is an option for `diary-display-function'."
(if (calendar-date-equal date (car h))
(setq date-holiday-list (append date-holiday-list
(cdr h)))))
- (insert (if (bobp) "" ?\n) (calendar-date-string date))
+ (insert (if (bobp) "" ?\n)
+ (propertize (calendar-date-string date)
+ 'font-lock-face 'diary))
(if date-holiday-list (insert ": "))
(setq cc (current-column))
(insert (mapconcat (lambda (x)
@@ -1100,7 +1102,10 @@ This is an option for `diary-display-function'."
x)
date-holiday-list
(concat "\n" (make-string cc ?\s))))
- (insert ?\n (make-string (+ cc longest) ?=) ?\n)))
+ (insert ?\n
+ (propertize (make-string (+ cc longest) ?=)
+ 'font-lock-face 'diary)
+ ?\n)))
(let ((this-entry (cadr entry))
this-loc marks temp-face)
(unless (zerop (length this-entry))
@@ -2394,6 +2399,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
(defun diary-fancy-date-pattern ()
"Return a regexp matching the first line of a fancy diary date header.
This depends on the calendar date style."
+ (declare (obsolete nil "28.1"))
(concat
(calendar-dlet*
((dayname (diary-name-pattern calendar-day-name-array nil t))
@@ -2414,15 +2420,17 @@ This depends on the calendar date style."
(defun diary-fancy-date-matcher (limit)
"Search for a fancy diary data header, up to LIMIT."
+ (declare (obsolete nil "28.1"))
;; Any number of " other holiday name" lines, followed by "==" line.
- (when (re-search-forward
- (format "%s\\(\n +.*\\)*\n=+$" (diary-fancy-date-pattern)) limit t)
- (put-text-property (match-beginning 0) (match-end 0) 'font-lock-multiline t)
- t))
+ (with-suppressed-warnings ((obsolete diary-fancy-date-pattern))
+ (when (re-search-forward
+ (format "%s\\(\n +.*\\)*\n=+$" (diary-fancy-date-pattern)) limit t)
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'font-lock-multiline t)
+ t)))
(defvar diary-fancy-font-lock-keywords
- `((diary-fancy-date-matcher . 'diary)
- ("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
+ `(("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
("^.*Yahrzeit.*$" . font-lock-constant-face)
("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
("^Day.*omer.*$" . font-lock-builtin-face)
@@ -2443,9 +2451,6 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil."
(if (looking-at "=+$") (forward-line -1))
(while (and (looking-at " +[^ ]")
(zerop (forward-line -1))))
- ;; This check not essential.
- (if (looking-at (diary-fancy-date-pattern))
- (setq beg (line-beginning-position)))
(goto-char end)
(forward-line 0)
(while (and (looking-at " +[^ ]")
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 6847ba97496..dab277487e2 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -6,7 +6,7 @@
;; Created: August 2002
;; Keywords: calendar
;; Human-Keywords: calendar, diary, iCalendar, vCalendar
-;; Version: 0.19
+;; Old-Version: 0.19
;; This file is part of GNU Emacs.
@@ -107,6 +107,7 @@
(defconst icalendar-version "0.19"
"Version number of icalendar.el.")
+(make-obsolete-variable 'icalendar-version nil "28.1")
;; ======================================================================
;; Customizables
@@ -514,9 +515,10 @@ The strings are suitable for assembling into a TZ variable."
(let* ((offsetto (car (cddr (assq 'TZOFFSETTO alist))))
(offsetfrom (car (cddr (assq 'TZOFFSETFROM alist))))
(rrule-value (car (cddr (assq 'RRULE alist))))
+ (rdate-p (and (assq 'RDATE alist) t))
(dtstart (car (cddr (assq 'DTSTART alist))))
- (no-dst (equal offsetto offsetfrom)))
- ;; FIXME: for now we only handle RRULE and not RDATE here.
+ (no-dst (or rdate-p (equal offsetto offsetfrom))))
+ ;; FIXME: the presence of an RDATE is assumed to denote the first day of the year
(when (and offsetto dtstart (or rrule-value no-dst))
(let* ((rrule (icalendar--split-value rrule-value))
(freq (cadr (assq 'FREQ rrule)))
@@ -560,12 +562,13 @@ The strings are suitable for assembling into a TZ variable."
(defun icalendar--parse-vtimezone (alist)
"Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
+Consider only the most recent date specification.
Return nil if timezone cannot be parsed."
(let* ((tz-id (icalendar--convert-string-for-import
(icalendar--get-event-property alist 'TZID)))
- (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT))))
+ (daylight (cadr (cdar (icalendar--get-most-recent-observance alist 'DAYLIGHT))))
(day (and daylight (icalendar--convert-tz-offset daylight t)))
- (standard (cadr (cdar (icalendar--get-children alist 'STANDARD))))
+ (standard (cadr (cdar (icalendar--get-most-recent-observance alist 'STANDARD))))
(std (and standard (icalendar--convert-tz-offset standard nil))))
(if (and tz-id std)
(cons tz-id
@@ -574,6 +577,28 @@ Return nil if timezone cannot be parsed."
"," (cdr day) "," (cdr std))
(car std))))))
+(defun icalendar--get-most-recent-observance (alist sub-comp)
+ "Return the latest observance for SUB-COMP DAYLIGHT or STANDARD.
+ALIST is a VTIMEZONE potentially containing historical records."
+;FIXME?: "most recent" should be relative to a given date
+ (let ((components (icalendar--get-children alist sub-comp)))
+ (list
+ (car
+ (sort components
+ #'(lambda (a b)
+ (let* ((get-recent (lambda (n)
+ (car
+ (sort
+ (delq nil
+ (mapcar (lambda (p)
+ (and (memq (car p) '(DTSTART RDATE))
+ (car (cddr p))))
+ n))
+ 'string-greaterp))))
+ (a-recent (funcall get-recent (car (cddr a))))
+ (b-recent (funcall get-recent (car (cddr b)))))
+ (string-greaterp a-recent b-recent))))))))
+
(defun icalendar--convert-all-timezones (icalendar)
"Convert all timezones in the ICALENDAR into an alist.
Each element of the alist is a cons (ID . TZ-STRING),
@@ -593,15 +618,18 @@ ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
(cdr (assoc id zone-map)))))
(defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
- zone)
+ source-zone
+ result-zone)
"Return ISODATETIMESTRING in format like `decode-time'.
Converts from ISO-8601 to Emacs representation. If
ISODATETIMESTRING specifies UTC time (trailing letter Z) the
decoded time is given in the local time zone! If optional
parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
days.
-ZONE, if provided, is the timezone, in any format understood by `encode-time'.
-
+SOURCE-ZONE, if provided, is the timezone for decoding the time,
+in any format understood by `encode-time'.
+RESULT-ZONE, if provided, is the timezone for encoding the result
+in any format understood by `decode-time'.
FIXME: multiple comma-separated values should be allowed!"
(icalendar--dmsg isodatetimestring)
(if isodatetimestring
@@ -623,7 +651,10 @@ FIXME: multiple comma-separated values should be allowed!"
(when (and (> (length isodatetimestring) 15)
;; UTC specifier present
(char-equal ?Z (aref isodatetimestring 15)))
- (setq zone t))
+ (setq source-zone t
+ ;; decode to local time unless result-zone is explicitly given,
+ ;; i.e. do not decode to UTC, i.e. do not (setq result-zone t)
+ ))
;; shift if necessary
(if day-shift
(let ((mdy (calendar-gregorian-from-absolute
@@ -636,9 +667,9 @@ FIXME: multiple comma-separated values should be allowed!"
;; create the decoded date-time
;; FIXME!?!
(let ((decoded-time (list second minute hour day month year
- nil -1 zone)))
+ nil -1 source-zone)))
(condition-case nil
- (decode-time (encode-time decoded-time))
+ (decode-time (encode-time decoded-time) result-zone)
(error
(message "Cannot decode \"%s\"" isodatetimestring)
;; Hope for the best....
@@ -684,9 +715,9 @@ FIXME: multiple comma-separated values should be allowed!"
(setq days (1- days))))
((match-beginning 4) ;days and time
(if (match-beginning 5)
- (setq days (* 7 (read (substring isodurationstring
- (match-beginning 6)
- (match-end 6))))))
+ (setq days (read (substring isodurationstring
+ (match-beginning 6)
+ (match-end 6)))))
(if (match-beginning 7)
(setq hours (read (substring isodurationstring
(match-beginning 8)
diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el
index ae1dab17252..906c29b15f4 100644
--- a/lisp/calendar/iso8601.el
+++ b/lisp/calendar/iso8601.el
@@ -69,6 +69,8 @@
"\\([+-]?[0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)")
(defconst iso8601--outdated-date-match
"--\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)")
+(defconst iso8601--outdated-reduced-precision-date-match
+ "---?\\([0-9][0-9]\\)")
(defconst iso8601--week-date-match
"\\([+-]?[0-9][0-9][0-9][0-9]\\)-?W\\([0-9][0-9]\\)-?\\([0-9]\\)?")
(defconst iso8601--ordinal-date-match
@@ -79,6 +81,7 @@
iso8601--full-date-match
iso8601--without-day-match
iso8601--outdated-date-match
+ iso8601--outdated-reduced-precision-date-match
iso8601--week-date-match
iso8601--ordinal-date-match)))
@@ -136,7 +139,8 @@ See `decode-time' for the meaning of FORM."
(when zone-string
(setf (decoded-time-zone date)
;; The time zone in decoded times are in seconds.
- (* (iso8601-parse-zone zone-string) 60)))
+ (* (iso8601-parse-zone zone-string) 60))
+ (setf (decoded-time-dst date) nil))
date)))
(defun iso8601-parse-date (string)
@@ -201,6 +205,12 @@ See `decode-time' for the meaning of FORM."
(iso8601--decoded-time :year year
:month (decoded-time-month month-day)
:day (decoded-time-day month-day))))
+ ;; Obsolete format with implied year: --MM
+ ((iso8601--match "--\\([0-9][0-9]\\)" string)
+ (iso8601--decoded-time :month (string-to-number (match-string 1 string))))
+ ;; Obsolete format with implied year and month: ---DD
+ ((iso8601--match "---\\([0-9][0-9]\\)" string)
+ (iso8601--decoded-time :day (string-to-number (match-string 1 string))))
(t
(signal 'wrong-type-argument string))))
@@ -332,6 +342,9 @@ Return the number of minutes."
(list start end
(or duration
;; FIXME: Support subseconds.
+ ;; FIXME: It makes no sense to decode a time difference
+ ;; according to (decoded-time-zone end), or according to
+ ;; any other time zone for that matter.
(decode-time (time-subtract (iso8601--encode-time end)
(iso8601--encode-time start))
(or (decoded-time-zone end) 0) 'integer)))))
@@ -354,7 +367,7 @@ Return the number of minutes."
(iso8601--value month)
(iso8601--value year)
nil
- dst
+ (if (or dst zone) dst -1)
zone))
(defun iso8601--encode-time (time)
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index 616d2b0c4ed..1c0f4da0f4b 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -1,4 +1,4 @@
-;;; lunar.el --- calendar functions for phases of the moon
+;;; lunar.el --- calendar functions for phases of the moon -*- lexical-binding:t -*-
;; Copyright (C) 1992-1993, 1995, 1997, 2001-2020 Free Software
;; Foundation, Inc.
@@ -91,6 +91,7 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(* -0.0016528 time time)
(* -0.00000239 time time time))
360.0))
+ (eclipse (eclipse-check moon-lat phase))
(adjustment
(if (memq phase '(0 2))
(+ (* (- 0.1734 (* 0.000393 time))
@@ -146,7 +147,26 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(time (* 24 (- date (truncate date))))
(date (calendar-gregorian-from-absolute (truncate date)))
(adj (dst-adjust-time date time)))
- (list (car adj) (apply 'solar-time-string (cdr adj)) phase)))
+ (list (car adj) (apply 'solar-time-string (cdr adj)) phase eclipse)))
+
+;; from "Astronomy with your Personal Computer", Subroutine Eclipse
+;; Line 7000 Peter Duffett-Smith Cambridge University Press 1990
+(defun eclipse-check (moon-lat phase)
+ (let* ((moon-lat (* (/ float-pi 180) moon-lat))
+ (moon-lat (abs (- moon-lat (* (floor (/ moon-lat float-pi))
+ float-pi))))
+ (moon-lat (if (> moon-lat 0.37)
+ (- float-pi moon-lat)
+ moon-lat))
+ (phase-name (cond ((= phase 0) "Solar")
+ ((= phase 2) "Lunar")
+ (t ""))))
+ (cond ((< moon-lat 2.42600766e-1)
+ (concat "** " phase-name " Eclipse **"))
+ ((< moon-lat 0.37)
+ (concat "** " phase-name " Eclipse possible **"))
+ (t
+ ""))))
(defconst lunar-cycles-per-year 12.3685 ; 365.25/29.530588853
"Mean number of lunar cycles per 365.25 day year.")
@@ -222,9 +242,10 @@ use instead of point."
(insert
(mapconcat
(lambda (x)
- (format "%s: %s %s" (calendar-date-string (car x))
+ (format "%s: %s %s %s" (calendar-date-string (car x))
(lunar-phase-name (nth 2 x))
- (cadr x)))
+ (cadr x)
+ (car (last x))))
(lunar-phase-list m1 y1) "\n")))
(message "Computing phases of the moon...done"))))
@@ -234,6 +255,8 @@ use instead of point."
If called with an optional prefix argument ARG, prompts for month and year.
This function is suitable for execution in an init file."
(interactive "P")
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(save-excursion
(let* ((date (if arg (calendar-read-date t)
(calendar-current-date)))
@@ -241,18 +264,17 @@ This function is suitable for execution in an init file."
(displayed-year (calendar-extract-year date)))
(calendar-lunar-phases))))
-;; The function below is designed to be used in sexp diary entries,
-;; and may be present in users' diary files, so suppress the warning
-;; about this prefix-less dynamic variable. It's called from
-;; `diary-list-sexp-entries', which binds the variable.
-(with-suppressed-warnings ((lexical date))
- (defvar date))
-
;;;###diary-autoload
(defun diary-lunar-phases (&optional mark)
"Moon phases diary entry.
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(let* ((index (lunar-index date))
(phase (lunar-phase index)))
(while (calendar-date-compare phase (list date))
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index 7110a81f0de..b199fca2db5 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -149,62 +149,62 @@ letters, digits, plus or minus signs or colons."
;;;###autoload
(defun parse-time-string (string)
"Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
-STRING should be something resembling an RFC 822 (or later) date-time, e.g.,
-\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is
+STRING should be an ISO 8601 time string, e.g., \"2020-01-15T16:12:21-08:00\",
+or something resembling an RFC 822 (or later) date-time, e.g.,
+\"Wed, 15 Jan 2020 16:12:21 -0800\". This function is
somewhat liberal in what format it accepts, and will attempt to
return a \"likely\" value even for somewhat malformed strings.
The values returned are identical to those of `decode-time', but
any unknown values other than DST are returned as nil, and an
unknown DST value is returned as -1."
- (let ((time (list nil nil nil nil nil nil nil -1 nil))
- (temp (parse-time-tokenize (downcase string))))
- (while temp
- (let ((parse-time-elt (pop temp))
- (rules parse-time-rules)
- (exit nil))
- (while (and rules (not exit))
- (let* ((rule (pop rules))
- (slots (pop rule))
- (predicate (pop rule))
- (parse-time-val))
- (when (and (not (nth (car slots) time)) ;not already set
- (setq parse-time-val
- (cond ((and (consp predicate)
- (not (functionp predicate)))
- (and (numberp parse-time-elt)
- (<= (car predicate) parse-time-elt)
- (or (not (cdr predicate))
- (<= parse-time-elt
- (cadr predicate)))
- parse-time-elt))
- ((symbolp predicate)
- (cdr (assoc parse-time-elt
- (symbol-value predicate))))
- ((funcall predicate)))))
- (setq exit t)
- (while slots
- (let ((new-val (if rule
- (let ((this (pop rule)))
- (if (vectorp this)
- (cl-parse-integer
- parse-time-elt
- :start (aref this 0)
- :end (aref this 1))
- (funcall this)))
- parse-time-val)))
- (setf (nth (pop slots) time) new-val))))))))
- time))
+ (condition-case ()
+ (iso8601-parse string)
+ (wrong-type-argument
+ (let ((time (list nil nil nil nil nil nil nil -1 nil))
+ (temp (parse-time-tokenize (downcase string))))
+ (while temp
+ (let ((parse-time-elt (pop temp))
+ (rules parse-time-rules)
+ (exit nil))
+ (while (and rules (not exit))
+ (let* ((rule (pop rules))
+ (slots (pop rule))
+ (predicate (pop rule))
+ (parse-time-val))
+ (when (and (not (nth (car slots) time)) ;not already set
+ (setq parse-time-val
+ (cond ((and (consp predicate)
+ (not (functionp predicate)))
+ (and (numberp parse-time-elt)
+ (<= (car predicate) parse-time-elt)
+ (or (not (cdr predicate))
+ (<= parse-time-elt
+ (cadr predicate)))
+ parse-time-elt))
+ ((symbolp predicate)
+ (cdr (assoc parse-time-elt
+ (symbol-value predicate))))
+ ((funcall predicate)))))
+ (setq exit t)
+ (while slots
+ (let ((new-val (if rule
+ (let ((this (pop rule)))
+ (if (vectorp this)
+ (cl-parse-integer
+ parse-time-elt
+ :start (aref this 0)
+ :end (aref this 1))
+ (funcall this)))
+ parse-time-val)))
+ (setf (nth (pop slots) time) new-val))))))))
+ time))))
(defun parse-iso8601-time-string (date-string)
- "Parse an ISO 8601 time string, such as 2016-12-01T23:35:06-05:00.
-If DATE-STRING cannot be parsed, it falls back to
-`parse-time-string'."
- (when-let ((time
- (if (iso8601-valid-p date-string)
- (decoded-time-set-defaults (iso8601-parse date-string))
- ;; Fall back to having `parse-time-string' do fancy
- ;; things for us.
- (parse-time-string date-string))))
+ "Parse an ISO 8601 time string, such as \"2020-01-15T16:12:21-08:00\".
+Fall back on parsing something resembling an RFC 822 (or later) date-time.
+This function is like `parse-time-string' except that it returns
+a Lisp timestamp when successful."
+ (when-let ((time (parse-time-string date-string)))
(encode-time time)))
(provide 'parse-time)
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 6a813e9ee82..07562f62240 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -209,7 +209,6 @@ Returns nil if nothing was entered."
(defun solar-setup ()
"Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'."
- (beep)
(or calendar-longitude
(setq calendar-longitude
(solar-get-number
@@ -491,8 +490,8 @@ Uses binary search."
(utmin (+ ut (* direction 12.0)))
(utmax ut) ; the time searched is between utmin and utmax
;; utmin and utmax are in hours.
- (utmoment-old 0.0) ; rise or set approximation
- (utmoment 1.0) ; rise or set approximation
+ (utmoment-old utmin) ; rise or set approximation
+ (utmoment utmax) ; rise or set approximation
(hut 0) ; sun height at utmoment
(t0 (car time))
(hmin (cadr (solar-horizontal-coordinates (list t0 utmin)
@@ -840,7 +839,9 @@ This function is suitable for execution in an init file."
"E" "W"))))))
(calendar-standard-time-zone-name
(if (< arg 16) calendar-standard-time-zone-name
- (cond ((zerop calendar-time-zone) "UTC")
+ (cond ((zerop calendar-time-zone)
+ (if (eq calendar-time-zone-style 'numeric)
+ "+0000" "UTC"))
((< calendar-time-zone 0)
(format "UTC%dmin" calendar-time-zone))
(t (format "UTC+%dmin" calendar-time-zone)))))
@@ -1013,7 +1014,10 @@ Requires floating point."
(let* ((m displayed-month)
(y displayed-year)
(calendar-standard-time-zone-name
- (if calendar-time-zone calendar-standard-time-zone-name "UTC"))
+ (cond
+ (calendar-time-zone calendar-standard-time-zone-name)
+ ((eq calendar-time-zone-style 'numeric) "+0000")
+ (t "UTC")))
(calendar-daylight-savings-starts
(if calendar-time-zone calendar-daylight-savings-starts))
(calendar-daylight-savings-ends
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 1e589ece29d..cf6c20afbd2 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -1,4 +1,4 @@
-;;; time-date.el --- Date and time handling functions
+;;; time-date.el --- Date and time handling functions -*- lexical-binding: t -*-
;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
@@ -278,6 +278,10 @@ Lower-case specifiers return only the unit.
optional leading \".\" for zero-padding. For example, \"%.3Y\" will
return something of the form \"001 year\".
+The \"%s\" spec takes an additional optional parameter,
+introduced by the \",\" character, to say how many decimals to
+use. \"%,1s\" means \"use one decimal\".
+
The \"%z\" specifier does not print anything. When it is used, specifiers
must be given in order of decreasing size. To the left of \"%z\", nothing
is output until the first non-zero unit is encountered."
@@ -289,10 +293,11 @@ is output until the first non-zero unit is encountered."
("s" "second" 1)
("z")))
(case-fold-search t)
- spec match usedunits zeroflag larger prev name unit num zeropos)
- (while (string-match "%\\.?[0-9]*\\(.\\)" string start)
+ spec match usedunits zeroflag larger prev name unit num zeropos
+ fraction)
+ (while (string-match "%\\.?[0-9]*\\(,[0-9]\\)?\\(.\\)" string start)
(setq start (match-end 0)
- spec (match-string 1 string))
+ spec (match-string 2 string))
(unless (string-equal spec "%")
(or (setq match (assoc (downcase spec) units))
(error "Bad format specifier: `%s'" spec))
@@ -307,12 +312,17 @@ is output until the first non-zero unit is encountered."
(push match usedunits)))
(and zeroflag larger
(error "Units are not in decreasing order of size"))
- (setq seconds (time-convert seconds 'integer))
+ (unless (numberp seconds)
+ (setq seconds (float-time seconds)))
+ (setq fraction (mod seconds 1)
+ seconds (round seconds))
(dolist (u units)
(setq spec (car u)
name (cadr u)
unit (nth 2 u))
- (when (string-match (format "%%\\(\\.?[0-9]+\\)?\\(%s\\)" spec) string)
+ (when (string-match
+ (format "%%\\(\\.?[0-9]+\\)?\\(,[0-9]+\\)?\\(%s\\)" spec)
+ string)
(if (string-equal spec "z") ; must be last in units
(setq string
(replace-regexp-in-string
@@ -327,9 +337,23 @@ is output until the first non-zero unit is encountered."
(setq zeropos (unless (zerop num) (match-beginning 0))))
(setq string
(replace-match
- (format (concat "%" (match-string 1 string) "d%s") num
- (if (string-equal (match-string 2 string) spec)
- "" ; lower-case, no unit-name
+ (format (if (match-string 2 string)
+ (concat
+ "%"
+ (and (match-string 1 string)
+ (if (= (elt (match-string 1 string) 0) ?.)
+ (concat "0" (substring
+ (match-string 1 string) 1))
+ (match-string 1 string)))
+ (concat "." (substring
+ (match-string 2 string) 1))
+ "f%s")
+ (concat "%" (match-string 1 string) "d%s"))
+ (if (= unit 1)
+ (+ num fraction)
+ num)
+ (if (string-equal (match-string 3 string) spec)
+ "" ; lower-case, no unit-name
(format " %s%s" name
(if (= num 1) "" "s"))))
t t string))))))
@@ -355,6 +379,8 @@ is output until the first non-zero unit is encountered."
(defun date-days-in-month (year month)
"The number of days in MONTH in YEAR."
+ (unless (and (numberp month) (<= 1 month 12))
+ (error "Month %s is invalid" month))
(if (= month 2)
(if (date-leap-year-p year)
29
@@ -399,10 +425,10 @@ changes in daylight saving time are not taken into account."
(when (decoded-time-year delta)
(cl-incf (decoded-time-year time) (decoded-time-year delta)))
- ;; Months are pretty simple.
+ ;; Months are pretty simple, but start at 1 (for January).
(when (decoded-time-month delta)
- (let ((new (+ (decoded-time-month time) (decoded-time-month delta))))
- (setf (decoded-time-month time) (mod new 12))
+ (let ((new (+ (1- (decoded-time-month time)) (decoded-time-month delta))))
+ (setf (decoded-time-month time) (1+ (mod new 12)))
(cl-incf (decoded-time-year time) (/ new 12))))
;; Adjust for month length (as described in the doc string).
@@ -515,17 +541,31 @@ TIME is modified and returned."
(unless (decoded-time-year time)
(setf (decoded-time-year time) 0))
- ;; When we don't have a time zone and we don't have a DST, then mark
- ;; it as unknown.
- (when (and (not (decoded-time-zone time))
- (not (decoded-time-dst time)))
- (setf (decoded-time-dst time) -1))
+ ;; When we don't have a time zone, default to DEFAULT-ZONE without
+ ;; DST if DEFAULT-ZONE if given, and to unknown DST otherwise.
+ (unless (decoded-time-zone time)
+ (if default-zone
+ (progn (setf (decoded-time-zone time) default-zone)
+ (setf (decoded-time-dst time) nil))
+ (setf (decoded-time-dst time) -1)))
- (when (and (not (decoded-time-zone time))
- default-zone)
- (setf (decoded-time-zone time) 0))
time)
+(defun decoded-time-period (time)
+ "Interpret DECODED as a period and return its length in seconds.
+For computational purposes, years are 365 days long and months
+are 30 days long."
+ (+ (if (consp (decoded-time-second time))
+ ;; Fractional second.
+ (/ (float (car (decoded-time-second time)))
+ (cdr (decoded-time-second time)))
+ (or (decoded-time-second time) 0))
+ (* (or (decoded-time-minute time) 0) 60)
+ (* (or (decoded-time-hour time) 0) 60 60)
+ (* (or (decoded-time-day time) 0) 60 60 24)
+ (* (or (decoded-time-month time) 0) 60 60 24 30)
+ (* (or (decoded-time-year time) 0) 60 60 24 365)))
+
(provide 'time-date)
;;; time-date.el ends here
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index ca9f16ef20b..48028dd07bf 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -4,7 +4,7 @@
;; Author: John Wiegley <johnw@gnu.org>
;; Created: 25 Mar 1999
-;; Version: 2.6.1
+;; Old-Version: 2.6.1
;; Keywords: calendar data
;; This file is part of GNU Emacs.
@@ -37,8 +37,6 @@
;; You'll probably want to bind the timeclock commands to some handy
;; keystrokes. At the moment, C-x t is unused:
;;
-;; (require 'timeclock)
-;;
;; (define-key ctl-x-map "ti" 'timeclock-in)
;; (define-key ctl-x-map "to" 'timeclock-out)
;; (define-key ctl-x-map "tc" 'timeclock-change)
@@ -193,6 +191,8 @@ to today."
(defcustom timeclock-load-hook nil
"Hook that gets run after timeclock has been loaded."
:type 'hook)
+(make-obsolete-variable 'timeclock-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom timeclock-in-hook nil
"A hook run every time an \"in\" event is recorded."
@@ -595,9 +595,9 @@ arguments of `completing-read'."
(defun timeclock-ask-for-project ()
"Ask the user for the project they are clocking into."
(completing-read
- (format "Clock into which project (default %s): "
- (or timeclock-last-project
- (car timeclock-project-list)))
+ (format-prompt "Clock into which project"
+ (or timeclock-last-project
+ (car timeclock-project-list)))
timeclock-project-list
nil nil nil nil
(or timeclock-last-project
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index a49f428a3c8..3975a9ba6a9 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -1937,11 +1937,13 @@ their associated keys and their effects."
(find-file-noselect file 'nowarn)
(set-window-buffer (selected-window)
(set-buffer (find-buffer-visiting file)))
- ;; If this command was invoked outside of a Todo mode buffer,
- ;; the call to todo-current-category above returned nil. If
- ;; we just entered Todo mode now, then cat was set to the
- ;; file's first category, but if todo-mode was already
- ;; enabled, cat did not get set, so we have to do that.
+ ;; If FILE is not in Todo mode, set it now, which also sets
+ ;; CAT to the file's first category.
+ (unless (derived-mode-p 'todo-mode) (todo-mode))
+ ;; But if FILE was already in todo-mode and the item insertion
+ ;; command was invoked outside of a Todo mode buffer, the
+ ;; above calls to todo-current-category returned nil, so we
+ ;; have to explicitly set CAT to the current category.
(unless cat
(setq cat (todo-current-category)))
(setq todo-current-todo-file file)
@@ -2169,7 +2171,9 @@ the item at point."
(if comment-delete
(when (todo-y-or-n-p "Delete comment? ")
(delete-region (match-beginning 0) (match-end 0)))
- (replace-match (read-string prompt (cons (match-string 1) 1))
+ (replace-match (save-match-data
+ (read-string prompt
+ (cons (match-string 1) 1)))
nil nil nil 1))
(if comment-delete
(user-error "There is no comment to delete")
@@ -2348,25 +2352,35 @@ made in the number or names of categories."
((or (string= omonth "*") (= mm 13))
(user-error "Cannot increment *"))
(t
- (let ((mminc (+ mm inc (if (< inc 0) 12 0))))
- ;; Increment or decrement month by INC
- ;; modulo 12.
- (setq mm (% mminc 12))
- ;; If result is 0, make month December.
- (setq mm (if (= mm 0) 12 (abs mm)))
+ (let* ((mmo mm)
+ ;; Change by 12 or more months?
+ (bigincp (>= (abs inc) 12))
+ ;; Month number is in range 1..12.
+ (mminc (+ mm (% inc 12)))
+ (mm (% (+ mminc 12) 12))
+ ;; 12n mod 12 = 0, so 0 is December.
+ (mm (if (= mm 0) 12 mm))
+ ;; Does change in month cross year?
+ (mmcmp (cond ((< inc 0) (> mm mmo))
+ ((> inc 0) (< mm mmo))))
+ (yyadjust (if bigincp
+ (+ (abs (/ inc 12))
+ (if mmcmp 1 0))
+ 1)))
;; Adjust year if necessary.
- (setq year (or (and (cond ((> mminc 12)
- (+ yy (/ mminc 12)))
- ((< mminc 1)
- (- yy (/ mminc 12) 1))
- (t yy))
- (number-to-string yy))
- oyear)))
- ;; Return the changed numerical month as
- ;; a string or the corresponding month name.
- (if omonth
- (number-to-string mm)
- (aref tma-array (1- mm))))))
+ (setq yy (cond ((and (< inc 0)
+ (or mmcmp bigincp))
+ (- yy yyadjust))
+ ((and (> inc 0)
+ (or mmcmp bigincp))
+ (+ yy yyadjust))
+ (t yy)))
+ (setq year (number-to-string yy))
+ ;; Return the changed numerical month as
+ ;; a string or the corresponding month name.
+ (if omonth
+ (number-to-string mm)
+ (aref tma-array (1- mm)))))))
;; Since the number corresponding to the arbitrary
;; month name "*" is out of the range of
;; calendar-last-day-of-month, set it to 1
@@ -4062,7 +4076,9 @@ regexp items."
((equal (file-name-extension f) "todt") "top")
((equal (file-name-extension f) "tody") "diary"))))
(push (cons (concat sf-name " (" type ")") f) falist)))
- (setq file (completing-read "Choose a filtered items file: " falist nil t nil
+ (setq file (completing-read (format-prompt "Choose a filtered items file"
+ (caar falist))
+ falist nil t nil
'todo--fifiles-history (caar falist)))
(setq file (cdr (assoc-string file falist)))
(find-file file)
@@ -4710,9 +4726,8 @@ name in `todo-directory'. See also the documentation string of
(todo-convert-legacy-date-time)))
(forward-line))
(setq file (concat todo-directory
- (read-string
- (format "Save file as (default \"%s\"): " default)
- nil nil default)
+ (read-string (format-prompt "Save file as" default)
+ nil nil default)
".todo"))
(unless (file-exists-p todo-directory)
(make-directory todo-directory))
@@ -5923,8 +5938,15 @@ categories from `todo-category-completions-files'."
(todo-absolute-file-name
(let ((files (mapcar #'todo-short-file-name catfil)))
(completing-read (format str cat) files)))))))
- ;; Default to the current file.
- (unless file0 (setq file0 todo-current-todo-file))
+ ;; When called without arg FILE, use fallback todo file.
+ (unless file0 (setq file0 (or todo-current-todo-file
+ ;; If we're outside of todo-mode
+ ;; but there is a current todo
+ ;; file, use it.
+ todo-global-current-todo-file
+ ;; Else, use the default todo file.
+ (todo-absolute-file-name
+ todo-default-todo-file))))
;; First validate only a name passed interactively from
;; todo-add-category, which must be of a nonexistent category.
(unless (and (assoc cat categories) (not add))
@@ -6087,11 +6109,12 @@ Valid time strings are those matching `diary-time-regexp'.
Typing `<return>' at the prompt returns the current time, if the
user option `todo-always-add-time-string' is non-nil, otherwise
the empty string (i.e., no time string)."
- (let (valid answer)
+ (let ((default (when todo-always-add-time-string
+ (format-time-string "%H:%M")))
+ valid answer)
(while (not valid)
- (setq answer (read-string "Enter a clock time: " nil nil
- (when todo-always-add-time-string
- (format-time-string "%H:%M"))))
+ (setq answer (read-string (format-prompt "Enter a clock time" default)
+ nil nil default))
(when (or (string= "" answer)
(string-match diary-time-regexp answer))
(setq valid t)))
@@ -6419,8 +6442,7 @@ Filtered Items mode following todo (not done) items."
("i" todo-insert-item)
("k" todo-delete-item)
("m" todo-move-item)
- ("u" todo-item-undone)
- ([remap newline] newline-and-indent))
+ ("u" todo-item-undone))
"List of key bindings for Todo mode only.")
(defvar todo-key-bindings-t+a+f
@@ -6486,7 +6508,6 @@ Filtered Items mode following todo (not done) items."
(defvar todo-edit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-x\C-q" 'todo-edit-quit)
- (define-key map [remap newline] 'newline-and-indent)
map)
"Todo Edit mode keymap.")
@@ -6645,7 +6666,6 @@ Added to `window-configuration-change-hook' in Todo mode."
(setq-local font-lock-defaults '(todo-font-lock-keywords t))
(setq-local revert-buffer-function #'todo-revert-buffer)
(setq-local tab-width todo-indent-to-here)
- (setq-local indent-line-function #'todo-indent)
(when todo-wrap-lines
(visual-line-mode)
(setq wrap-prefix (make-string todo-indent-to-here 32))))
@@ -6720,6 +6740,7 @@ Added to `window-configuration-change-hook' in Todo mode."
\\{todo-edit-mode-map}"
(todo-modes-set-1)
+ (setq-local indent-line-function #'todo-indent)
(if (> (buffer-size) (- (point-max) (point-min)))
;; Editing one item in an indirect buffer, so buffer-file-name is nil.
(setq-local todo-current-todo-file todo-global-current-todo-file)
diff --git a/lisp/case-table.el b/lisp/case-table.el
index 7379f379615..bdfe5c2b4d6 100644
--- a/lisp/case-table.el
+++ b/lisp/case-table.el
@@ -38,26 +38,26 @@
(interactive)
(let ((description (make-char-table 'case-table)))
(map-char-table
- (function (lambda (key value)
- (if (not (natnump value))
- (if (consp key)
- (set-char-table-range description key "case-invariant")
- (aset description key "case-invariant"))
- (let (from to)
- (if (consp key)
- (setq from (car key) to (cdr key))
- (setq from (setq to key)))
- (while (<= from to)
- (aset
- description from
- (cond ((/= from (downcase from))
- (concat "uppercase, matches "
- (char-to-string (downcase from))))
- ((/= from (upcase from))
- (concat "lowercase, matches "
- (char-to-string (upcase from))))
- (t "case-invariant")))
- (setq from (1+ from)))))))
+ (lambda (key value)
+ (if (not (natnump value))
+ (if (consp key)
+ (set-char-table-range description key "case-invariant")
+ (aset description key "case-invariant"))
+ (let (from to)
+ (if (consp key)
+ (setq from (car key) to (cdr key))
+ (setq from (setq to key)))
+ (while (<= from to)
+ (aset
+ description from
+ (cond ((/= from (downcase from))
+ (concat "uppercase, matches "
+ (char-to-string (downcase from))))
+ ((/= from (upcase from))
+ (concat "lowercase, matches "
+ (char-to-string (upcase from))))
+ (t "case-invariant")))
+ (setq from (1+ from))))))
(current-case-table))
(save-excursion
(with-output-to-temp-buffer "*Help*"
diff --git a/lisp/cdl.el b/lisp/cdl.el
index adc05f1bb52..c8025a9f530 100644
--- a/lisp/cdl.el
+++ b/lisp/cdl.el
@@ -1,4 +1,4 @@
-;;; cdl.el --- Common Data Language (CDL) utility functions for GNU Emacs
+;;; cdl.el --- Common Data Language (CDL) utility functions for GNU Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/cedet/ChangeLog.1 b/lisp/cedet/ChangeLog.1
index 93bd5872f3f..a1c0e41b8da 100644
--- a/lisp/cedet/ChangeLog.1
+++ b/lisp/cedet/ChangeLog.1
@@ -301,7 +301,7 @@
manipulation of `ede-projects' with equivalent and better
functions.
(ede-proj-load): Replace call to test if dir has project to
- explicity ask filesystem if Project.ede is there.
+ explicitly ask filesystem if Project.ede is there.
* ede/config.el:
* ede/detect.el: New files.
@@ -2101,7 +2101,7 @@
by calling `srecode-cpp-apply-templates'.
* srecode/compile.el (srecode-compile-templates): Fix directory
- compare of built-in templates. Give built-ins lower piority.
+ compare of built-in templates. Give built-ins lower priority.
Support special variable "project".
(srecode-compile-template-table): Set :project slot of new tables.
(srecode-compile-one-template-tag):
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index 78a72dd889c..44cce389cb3 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -38,7 +38,7 @@
;; "Calculate something complicated at point, and return it."
;; (interactive) ;; function not normally interactive
;; (let ((stuff (do-stuff)))
-;; (when (interactive-p)
+;; (when (called-interactively-p 'interactive)
;; (data-debug-show-stuff stuff "myStuff"))
;; stuff))
@@ -49,9 +49,9 @@
;;; Compatibility
;;
-(defalias 'data-debug-overlay-properties 'overlay-properties)
-(defalias 'data-debug-overlay-p 'overlayp)
-(defalias 'dd-propertize 'propertize)
+(define-obsolete-function-alias 'data-debug-overlay-properties 'overlay-properties "28.1")
+(define-obsolete-function-alias 'data-debug-overlay-p 'overlayp "28.1")
+(define-obsolete-function-alias 'dd-propertize 'propertize "28.1")
;;; GENERIC STUFF
;;
@@ -73,7 +73,7 @@ The attributes belong to the tag PARENT."
"Insert all the parts of OVERLAY.
PREFIX specifies what to insert at the start of each line."
(let ((attrprefix (concat (make-string (length prefix) ? ) "# "))
- (proplist (data-debug-overlay-properties overlay)))
+ (proplist (overlay-properties overlay)))
(data-debug-insert-property-list
proplist attrprefix)
)
@@ -393,10 +393,10 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
(lambda (key value)
(data-debug-insert-thing
key prefix
- (dd-propertize "key " 'face font-lock-comment-face))
+ (propertize "key " 'face font-lock-comment-face))
(data-debug-insert-thing
value prefix
- (dd-propertize "val " 'face font-lock-comment-face)))
+ (propertize "val " 'face font-lock-comment-face)))
hash-table))
(defun data-debug-insert-hash-table-from-point (point)
@@ -415,9 +415,9 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
(defun data-debug-insert-hash-table-button (hash-table prefix prebuttontext)
"Insert HASH-TABLE as expandable button with recursive prefix PREFIX and PREBUTTONTEXT in front of the button text."
- (let ((string (dd-propertize (format "%s" hash-table)
+ (let ((string (propertize (format "%s" hash-table)
'face 'font-lock-keyword-face)))
- (insert (dd-propertize
+ (insert (propertize
(concat prefix prebuttontext string)
'ddebug hash-table
'ddebug-indent (length prefix)
@@ -444,7 +444,7 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
(data-debug-insert-thing (car (cdr rest))
prefix
(concat
- (dd-propertize (format "%s" (car rest))
+ (propertize (format "%s" (car rest))
'face font-lock-comment-face)
" : "))
(setq rest (cdr (cdr rest))))
@@ -468,9 +468,9 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
A Symbol is a simple thing, but this provides some face and prefix rules.
PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the thing."
- (let ((string (dd-propertize (format "#<WIDGET %s>" (car widget))
+ (let ((string (propertize (format "#<WIDGET %s>" (car widget))
'face 'font-lock-keyword-face)))
- (insert (dd-propertize
+ (insert (propertize
(concat prefix prebuttontext string)
'ddebug widget
'ddebug-indent (length prefix)
@@ -613,7 +613,7 @@ PREBUTTONTEXT is some text between prefix and the stuff vector button."
(symbol-value symbol)
(concat (make-string indent ? ) "> ")
(concat
- (dd-propertize "value"
+ (propertize "value"
'face 'font-lock-comment-face)
" ")))
(data-debug-insert-property-list
@@ -628,13 +628,13 @@ PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the symbol button."
(let ((string
(cond ((fboundp symbol)
- (dd-propertize (concat "#'" (symbol-name symbol))
+ (propertize (concat "#'" (symbol-name symbol))
'face 'font-lock-function-name-face))
((boundp symbol)
- (dd-propertize (concat "'" (symbol-name symbol))
+ (propertize (concat "'" (symbol-name symbol))
'face 'font-lock-variable-name-face))
(t (format "'%s" symbol)))))
- (insert (dd-propertize
+ (insert (propertize
(concat prefix prebuttontext string)
'ddebug symbol
'ddebug-indent (length prefix)
@@ -657,7 +657,7 @@ PREBUTTONTEXT is some text between prefix and the thing."
(while (string-match "\t" newstr)
(setq newstr (replace-match "\\t" t t newstr)))
(insert prefix prebuttontext
- (dd-propertize (format "\"%s\"" newstr)
+ (propertize (format "\"%s\"" newstr)
'face font-lock-string-face)
"\n" )))
@@ -668,7 +668,7 @@ A Symbol is a simple thing, but this provides some face and prefix rules.
PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the thing."
(insert prefix prebuttontext
- (dd-propertize (format "%S" thing)
+ (propertize (format "%S" thing)
'face font-lock-string-face)
"\n"))
@@ -737,10 +737,10 @@ FACE is the face to use."
(null . data-debug-insert-nil)
;; Overlay
- (data-debug-overlay-p . data-debug-insert-overlay-button)
+ (overlayp . data-debug-insert-overlay-button)
;; Overlay list
- ((lambda (thing) (and (consp thing) (data-debug-overlay-p (car thing)))) .
+ ((lambda (thing) (and (consp thing) (overlayp (car thing)))) .
data-debug-insert-overlay-list-button)
;; Buffer
@@ -880,7 +880,7 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
comment-end ""
buffer-read-only t)
(setq-local comment-start-skip
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
(buffer-disable-undo)
(set (make-local-variable 'font-lock-global-modes) nil)
(font-lock-mode -1)
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 1418ad9539d..41252815734 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -470,7 +470,7 @@ To be used in hook functions."
;; Emacs 21 has no buffer file name for directory edits.
;; so we need to add these hacks in.
(eq major-mode 'dired-mode)
- (eq major-mode 'vc-dired-mode))
+ (eq major-mode 'vc-dir-mode))
(ede-minor-mode 1)))
(define-minor-mode ede-minor-mode
@@ -481,7 +481,7 @@ controlled project, then this mode is activated automatically
provided `global-ede-mode' is enabled."
:group 'ede
(cond ((or (eq major-mode 'dired-mode)
- (eq major-mode 'vc-dired-mode))
+ (eq major-mode 'vc-dir-mode))
(ede-dired-minor-mode (if ede-minor-mode 1 -1)))
(ede-minor-mode
(if (not ede-constructing)
@@ -1515,8 +1515,11 @@ It does not apply the value to buffers."
(when project-dir
(ede-directory-get-open-project project-dir 'ROOT))))
-(cl-defmethod project-roots ((project ede-project))
- (list (ede-project-root-directory project)))
+(cl-defmethod project-root ((project ede-project))
+ (ede-project-root-directory project))
+
+;;; FIXME: Could someone look into implementing `project-ignores' for
+;;; EDE and/or a faster `project-files'?
(add-hook 'project-find-functions #'project-try-ede)
@@ -1527,8 +1530,7 @@ It does not apply the value to buffers."
;; If this does not occur after the provide, we can get a recursive
;; load. Yuck!
-(if (featurep 'speedbar)
- (ede-speedbar-file-setup)
- (add-hook 'speedbar-load-hook 'ede-speedbar-file-setup))
+(with-eval-after-load 'speedbar
+ (ede-speedbar-file-setup))
;;; ede.el ends here
diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el
index ee8aa5db1b7..f0dbccb7fc1 100644
--- a/lisp/cedet/ede/cpp-root.el
+++ b/lisp/cedet/ede/cpp-root.el
@@ -478,21 +478,6 @@ Argument COMMAND is the command to use for compiling the target."
"Don't rescan this project from the sources."
(message "cpp-root has nothing to rescan."))
-;;; Quick Hack
-(defun ede-create-lots-of-projects-under-dir (dir projfile &rest attributes)
- "Create a bunch of projects under directory DIR.
-PROJFILE is a file name sans directory that indicates a subdirectory
-is a project directory.
-Generic ATTRIBUTES, such as :include-path can be added.
-Note: This needs some work."
- (let ((files (directory-files dir t)))
- (dolist (F files)
- (if (file-exists-p (expand-file-name projfile F))
- `(ede-cpp-root-project (file-name-nondirectory F)
- :name (file-name-nondirectory F)
- :file (expand-file-name projfile F)
- attributes)))))
-
(provide 'ede/cpp-root)
;; Local variables:
diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el
index 3e4499cd39e..fe23501807a 100644
--- a/lisp/cedet/ede/detect.el
+++ b/lisp/cedet/ede/detect.el
@@ -35,16 +35,6 @@
(require 'ede/auto) ;; Autoload settings.
-(when (or (<= emacs-major-version 23)
- ;; predicate as name added in Emacs 24.2
- (and (= emacs-major-version 24)
- (< emacs-minor-version 2)))
- (message "Loading CEDET fallback autoload library.")
- (require 'cedet/dominate
- (expand-file-name "../../../etc/fallback-libraries/dominate.el"
- (file-name-directory load-file-name))))
-
-
;;; BASIC PROJECT SCAN
;;
(defun ede--detect-stop-scan-p (dir)
diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el
index bfcbd40fcce..a052c5c61e7 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -234,20 +234,19 @@ All files need the macros from lisp.h!"
(let* ((D (car dirs))
(ed (expand-file-name D base))
(ef (expand-file-name name ed)))
- (if (file-exists-p ef)
- (setq ans ef)
- ;; Not in this dir? How about subdirs?
- (let ((dirfile (directory-files ed t))
- (moredirs nil)
- )
- ;; Get all the subdirs.
- (dolist (DF dirfile)
- (when (and (file-directory-p DF)
- (not (string-match "\\.$" DF)))
- (push DF moredirs)))
- ;; Try again.
- (setq ans (ede-emacs-find-in-directories name ed moredirs))
- ))
+ (when (file-exists-p ed)
+ (if (file-exists-p ef)
+ (setq ans ef)
+ ;; Not in this dir? How about subdirs?
+ (let ((dirfile (directory-files ed t))
+ (moredirs nil))
+ ;; Get all the subdirs.
+ (dolist (DF dirfile)
+ (when (and (file-directory-p DF)
+ (not (string-match "\\.$" DF)))
+ (push DF moredirs)))
+ ;; Try again.
+ (setq ans (ede-emacs-find-in-directories name ed moredirs)))))
(setq dirs (cdr dirs))))
ans))
diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el
index db539450e62..1d6a082c5d3 100644
--- a/lisp/cedet/ede/files.el
+++ b/lisp/cedet/ede/files.el
@@ -96,15 +96,12 @@ of the anchor file for the project."
(defun ede--put-inode-dir-hash (dir inode)
"Add to the EDE project hash DIR associated with INODE."
- (when (fboundp 'puthash)
- (puthash dir inode ede-inode-directory-hash)
- inode))
+ (puthash dir inode ede-inode-directory-hash)
+ inode)
(defun ede--get-inode-dir-hash (dir)
"Get the EDE project hash DIR associated with INODE."
- (when (fboundp 'gethash)
- (gethash dir ede-inode-directory-hash)
- ))
+ (gethash dir ede-inode-directory-hash))
(defun ede--inode-for-dir (dir)
"Return the inode for the directory DIR."
@@ -272,28 +269,24 @@ Do this only when developing new projects that are incorrectly putting
Do this whenever a new project is created, as opposed to loaded."
;; TODO - Use maphash, and delete by regexp, not by dir searching!
(setq dir (expand-file-name dir))
- (when (fboundp 'remhash)
- (remhash (file-name-as-directory dir) ede-project-directory-hash)
- ;; Look for all subdirs of D, and remove them.
- (let ((match (concat "^" (regexp-quote dir))))
- (maphash (lambda (K O)
- (when (string-match match K)
- (remhash K ede-project-directory-hash)))
- ede-project-directory-hash))
- ))
+ (remhash (file-name-as-directory dir) ede-project-directory-hash)
+ ;; Look for all subdirs of D, and remove them.
+ (let ((match (concat "^" (regexp-quote dir))))
+ (maphash (lambda (K O)
+ (when (string-match match K)
+ (remhash K ede-project-directory-hash)))
+ ede-project-directory-hash)))
(defun ede--directory-project-from-hash (dir)
"If there is an already loaded project for DIR, return it from the hash."
- (when (fboundp 'gethash)
- (setq dir (expand-file-name dir))
- (gethash dir ede-project-directory-hash nil)))
+ (setq dir (expand-file-name dir))
+ (gethash dir ede-project-directory-hash nil))
(defun ede--directory-project-add-description-to-hash (dir desc)
"Add to the EDE project hash DIR associated with DESC."
- (when (fboundp 'puthash)
- (setq dir (expand-file-name dir))
- (puthash dir desc ede-project-directory-hash)
- desc))
+ (setq dir (expand-file-name dir))
+ (puthash dir desc ede-project-directory-hash)
+ desc)
;;; DIRECTORY-PROJECT-P, -CONS
;;
diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el
index ecce3e7105b..140e7387a68 100644
--- a/lisp/cedet/ede/make.el
+++ b/lisp/cedet/ede/make.el
@@ -32,29 +32,15 @@
(declare-function inversion-check-version "inversion")
-(if (fboundp 'locate-file)
- (defsubst ede--find-executable (exec)
- "Return an expanded file name for a program EXEC on the exec path."
- (locate-file exec exec-path))
-
- ;; Else, older version of Emacs.
-
- (defsubst ede--find-executable (exec)
- "Return an expanded file name for a program EXEC on the exec path."
- (let ((p exec-path)
- (found nil))
- (while (and p (not found))
- (let ((f (expand-file-name exec (car p))))
- (if (file-exists-p f)
- (setq found f)))
- (setq p (cdr p)))
- found))
- )
+(defsubst ede--find-executable (exec)
+ "Return an expanded file name for a program EXEC on the exec path."
+ (declare (obsolete locate-file "28.1"))
+ (locate-file exec exec-path))
(defvar ede-make-min-version "3.0"
"Minimum version of GNU make required.")
-(defcustom ede-make-command (cond ((ede--find-executable "gmake")
+(defcustom ede-make-command (cond ((executable-find "gmake")
"gmake")
(t "make")) ;; What to do?
"The MAKE command to use for EDE when compiling.
diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el
index 63fb62b5a57..b85b397af2d 100644
--- a/lisp/cedet/ede/pconf.el
+++ b/lisp/cedet/ede/pconf.el
@@ -56,8 +56,9 @@ don't do it. A value of nil means to just do it.")
(and (eq ede-pconf-create-file-query 'ask)
(not (eq ede-pconf-create-file-query 'never))
(not (y-or-n-p
- (format "I had to create the %s file for you. Ok? " file)))
- (error "Quit")))))))
+ (format "I had to create the %s file for you. Ok? "
+ file))))
+ (error "Quit"))))))
(cl-defmethod ede-proj-configure-synchronize ((this ede-proj-project))
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index a0af4a4ddc5..bcd672133db 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -153,18 +153,9 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(let* ((fsrc (expand-file-name src dir))
(elc (concat (file-name-sans-extension fsrc) ".elc")))
(with-no-warnings
- (if (< emacs-major-version 24)
- ;; Does not have `byte-recompile-file'
- (if (or (not (file-exists-p elc))
- (file-newer-than-file-p fsrc elc))
- (progn
- (setq comp (1+ comp))
- (byte-compile-file fsrc))
- (setq utd (1+ utd)))
-
- (if (eq (byte-recompile-file fsrc nil 0) t)
- (setq comp (1+ comp))
- (setq utd (1+ utd)))))))
+ (if (eq (byte-recompile-file fsrc nil 0) t)
+ (setq comp (1+ comp))
+ (setq utd (1+ utd))))))
(oref obj source))
(message "All Emacs Lisp sources are up to date in %s" (eieio-object-name obj))
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 58a35d7d8a0..1be0e33c5fe 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -82,8 +82,6 @@ introduced."
This variable is for internal use only, and its content depends on the
external parser used.")
(make-variable-buffer-local 'semantic--parse-table)
-(semantic-varalias-obsolete 'semantic-toplevel-bovine-table
- 'semantic--parse-table "23.2")
(defvar semantic-symbol->name-assoc-list
'((type . "Types")
@@ -112,17 +110,6 @@ in classes, such as protection labels.")
"Value for `case-fold-search' when parsing.")
(make-variable-buffer-local 'semantic-case-fold)
-(defvar semantic-expand-nonterminal nil
- "Function to call for each nonterminal production.
-Return a list of non-terminals derived from the first argument, or nil
-if it does not need to be expanded.
-Languages with compound definitions should use this function to expand
-from one compound symbol into several. For example, in C the definition
- int a, b;
-is easily parsed into one tag. This function should take this
-compound tag and turn it into two tags, one for A, and the other for B.")
-(make-variable-buffer-local 'semantic-expand-nonterminal)
-
(defvar semantic--buffer-cache nil
"A cache of the fully parsed buffer.
If no significant changes have been made (based on the state) then
@@ -134,8 +121,6 @@ If you need a tag list, use `semantic-fetch-tags'. If you need the
cached values for some reason, chances are you can add a hook to
`semantic-after-toplevel-cache-change-hook'.")
(make-variable-buffer-local 'semantic--buffer-cache)
-(semantic-varalias-obsolete 'semantic-toplevel-bovine-cache
- 'semantic--buffer-cache "23.2")
(defvar semantic-unmatched-syntax-cache nil
"A cached copy of unmatched syntax tokens.")
@@ -171,18 +156,6 @@ It is called before any request for tags is made via the function
`semantic-fetch-tags' by an application.
If any hook returns a nil value, the cached value is returned
immediately, even if it is empty.")
-(semantic-varalias-obsolete 'semantic-before-toplevel-bovination-hook
- 'semantic--before-fetch-tags-hook "23.2")
-
-(defvar semantic-after-toplevel-bovinate-hook nil
- "Hooks run after a toplevel parse.
-It is not run if the toplevel parse command is called, and buffer does
-not need to be fully reparsed.
-For language specific hooks, make sure you define this as a local hook.
-
-This hook should not be used any more.
-Use `semantic-after-toplevel-cache-change-hook' instead.")
-(make-obsolete-variable 'semantic-after-toplevel-bovinate-hook nil "23.2")
(defvar semantic-after-toplevel-cache-change-hook nil
"Hooks run after the buffer tag list has changed.
@@ -305,13 +278,6 @@ This hook is for database functions which intend to swap in a tag table.
This guarantees that the DB will go before other modes that require
a parse of the buffer.")
-(semantic-varalias-obsolete 'semantic-init-hooks
- 'semantic-init-hook "23.2")
-(semantic-varalias-obsolete 'semantic-init-mode-hooks
- 'semantic-init-mode-hook "23.2")
-(semantic-varalias-obsolete 'semantic-init-db-hooks
- 'semantic-init-db-hook "23.2")
-
(defsubst semantic-error-if-unparsed ()
"Raise an error if current buffer was not parsed by Semantic."
(unless semantic-new-buffer-fcn-was-run
@@ -516,8 +482,6 @@ is requested."
(semantic-parse-tree-set-needs-rebuild)
;; Remove this hook which tracks if a buffer is up to date or not.
(remove-hook 'after-change-functions 'semantic-change-function t)
- ;; Old model. Delete someday.
- ;;(run-hooks 'semantic-after-toplevel-bovinate-hook)
(run-hook-with-args 'semantic-after-toplevel-cache-change-hook
semantic--buffer-cache)
@@ -540,17 +504,12 @@ is requested."
(setq semantic--completion-cache nil)
;; Refresh the display of unmatched syntax tokens if enabled
(run-hook-with-args 'semantic-unmatched-syntax-hook
- semantic-unmatched-syntax-cache)
- ;; Old Semantic 1.3 hook API. Maybe useful forever?
- (run-hooks 'semantic-after-toplevel-bovinate-hook)
- )
+ semantic-unmatched-syntax-cache))
(defvar semantic-working-type 'percent
"The type of working message to use when parsing.
'percent means we are doing a linear parse through the buffer.
'dynamic means we are reparsing specific tags.")
-(semantic-varalias-obsolete 'semantic-bovination-working-type
- 'semantic-working-type "23.2")
(defvar semantic-minimum-working-buffer-size (* 1024 5)
"The minimum size of a buffer before working messages are displayed.
@@ -586,8 +545,6 @@ was marked unparseable, then do nothing, and return the cache."
(semantic-active-p)
;; Application hooks say the buffer is safe for parsing
(run-hook-with-args-until-failure
- 'semantic-before-toplevel-bovination-hook)
- (run-hook-with-args-until-failure
'semantic--before-fetch-tags-hook)
;; If the buffer was previously marked unparseable,
;; then don't waste our time.
@@ -690,11 +647,6 @@ Does nothing if the current buffer doesn't need reparsing."
;; Return if we are lexically safe
lexically-safe))))
-(defun semantic-bovinate-toplevel (&optional ignored)
- "Backward compatibility function."
- (semantic-fetch-tags))
-(make-obsolete 'semantic-bovinate-toplevel 'semantic-fetch-tags "23.2")
-
;; Another approach is to let Emacs call the parser on idle time, when
;; needed, use `semantic-fetch-available-tags' to only retrieve
;; available tags, and setup the `semantic-after-*-hook' hooks to
@@ -812,20 +764,6 @@ This function returns semantic tags without overlays."
;; Please move away from these functions, and try using semantic 2.x
;; interfaces instead.
;;
-(defsubst semantic-bovinate-region-until-error
- (start end nonterm &optional depth)
- "NOTE: Use `semantic-parse-region' instead.
-
-Bovinate between START and END starting with NONTERM.
-Optional DEPTH specifies how many levels of parenthesis to enter.
-This command will parse until an error is encountered, and return
-the list of everything found until that moment.
-This is meant for finding variable definitions at the beginning of
-code blocks in methods. If `bovine-inner-scope' can also support
-commands, use `semantic-bovinate-from-nonterminal-full'."
- (semantic-parse-region start end nonterm depth t))
-(make-obsolete 'semantic-bovinate-region-until-error
- 'semantic-parse-region "23.2")
(defsubst semantic-bovinate-from-nonterminal
(start end nonterm &optional depth length)
@@ -840,21 +778,6 @@ tokens."
(semantic-lex start end (or depth 1) length)
nonterm))))
-(defsubst semantic-bovinate-from-nonterminal-full
- (start end nonterm &optional depth)
- "NOTE: Use `semantic-parse-region' instead.
-
-Bovinate from within a nonterminal lambda from START to END.
-Iterates until all the space between START and END is exhausted.
-Argument NONTERM is the nonterminal symbol to start with.
-If NONTERM is nil, use `bovine-block-toplevel'.
-Optional argument DEPTH is the depth of lists to dive into.
-When used in a `lambda' of a MATCH-LIST, there is no need to include
-a START and END part."
- (semantic-parse-region start end nonterm (or depth 1)))
-(make-obsolete 'semantic-bovinate-from-nonterminal-full
- 'semantic-parse-region "23.2")
-
;;; User interface
(defun semantic-force-refresh ()
@@ -1055,7 +978,6 @@ Prevent this load system from loading files in twice.")
global-semanticdb-minor-mode
global-semantic-idle-summary-mode
global-semantic-mru-bookmark-mode
- global-cedet-m3-minor-mode
global-semantic-idle-local-symbol-highlight-mode
global-semantic-highlight-edits-mode
global-semantic-show-unmatched-syntax-mode
@@ -1077,7 +999,6 @@ The possible elements of this list include the following:
`global-semantic-stickyfunc-mode' - Show current fun in header line.
`global-semantic-mru-bookmark-mode' - Provide `switch-to-buffer'-like
keybinding for tag names.
- `global-cedet-m3-minor-mode' - A mouse 3 context menu.
`global-semantic-idle-local-symbol-highlight-mode' - Highlight references
of the symbol under point.
The following modes are more targeted at people who want to see
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index 358829a4568..3649d1c2f1f 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -46,27 +46,10 @@
(declare-function c-forward-conditional "cc-cmds")
(declare-function ede-system-include-path "ede")
-;;; Compatibility
-;;
(eval-when-compile (require 'cc-mode))
-(if (fboundp 'c-end-of-macro)
- (eval-and-compile
- (defalias 'semantic-c-end-of-macro 'c-end-of-macro))
- ;; From cc-mode 5.30
- (defun semantic-c-end-of-macro ()
- "Go to the end of a preprocessor directive.
-More accurately, move point to the end of the closest following line
-that doesn't end with a line continuation backslash.
-
-This function does not do any hidden buffer changes."
- (while (progn
- (end-of-line)
- (when (and (eq (char-before) ?\\)
- (not (eobp)))
- (forward-char)
- t))))
- )
+(define-obsolete-function-alias 'semantic-c-end-of-macro
+ #'c-end-of-macro "28.1")
;;; Code:
(with-suppressed-warnings ((obsolete define-child-mode))
@@ -266,7 +249,7 @@ Return the defined symbol as a special spp lex token."
(semantic-lex-analyzer #'semantic-cpp-lexer)
(raw-stream
(semantic-lex-spp-stream-for-macro (save-excursion
- (semantic-c-end-of-macro)
+ (c-end-of-macro)
;; HACK - If there's a C comment after
;; the macro, do not parse it.
(if (looking-back "/\\*.*" beginning-of-define)
@@ -590,7 +573,7 @@ case, we must skip it since it is the ELSE part."
(define-lex-regex-analyzer semantic-lex-c-macrobits
"Ignore various forms of #if/#else/#endif conditionals."
"^\\s-*#\\s-*\\(if\\(n?def\\)?\\|endif\\|elif\\|else\\)"
- (semantic-c-end-of-macro)
+ (c-end-of-macro)
(setq semantic-lex-end-point (point))
nil)
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index 656c63b7eed..bbed1d94f20 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -420,7 +420,6 @@ Return a bovination list to use."
:parent (symbol-name (nth 2 form))
:documentation (semantic-elisp-do-doc (nth 4 form))
)))
- define-mode-overload-implementation ;; obsoleted
define-mode-local-override
)
@@ -650,7 +649,7 @@ define-mode-overload\\)\
))
(when fun
;; Do not return FUN IFF the cursor is on FUN.
- ;; Huh? Thats because if cursor is on fun, it is
+ ;; Huh? That's because if cursor is on fun, it is
;; the current symbol, and not the current function.
(if (save-excursion
(condition-case nil
diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el
index 7b835b85097..10afb065320 100644
--- a/lisp/cedet/semantic/bovine/grammar.el
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -143,8 +143,7 @@ expanded from elsewhere."
form (cdr form))
;; Hack for dealing with new reading of unquotes outside of
;; backquote (introduced in 2010-12-06T16:37:26Z!monnier@iro.umontreal.ca).
- (when (and (>= emacs-major-version 24)
- (listp first)
+ (when (and (listp first)
(or (equal (car first) '\,)
(equal (car first) '\,@)))
(if (listp (cadr first))
diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el
index 93ad27586ed..b2a25bf8eef 100644
--- a/lisp/cedet/semantic/bovine/scm.el
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -69,7 +69,7 @@ Attempts a simple prototype for calling or using TAG."
;; Note: Analyzer from Henry S. Thompson
(define-lex-regex-analyzer semantic-lex-scheme-symbol
"Detect and create symbol and keyword tokens."
- "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)*\\)"
+ "\\(\\sw\\|\\s_\\)+"
;; (message "symbol: %s" (match-string 0))
(semantic-lex-push-token
(semantic-lex-token
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index 7abc4360f64..b262ab710f6 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -1635,10 +1635,10 @@ This will not happen if you directly set this variable via `setq'."
:group 'semantic
:version "24.3"
:type 'integer
- :set '(lambda (sym var)
- (set-default sym var)
- (when (boundp 'x-max-tooltip-size)
- (setcdr x-max-tooltip-size (max (1+ var) (cdr x-max-tooltip-size))))))
+ :set (lambda (sym var)
+ (set-default sym var)
+ (when (boundp 'x-max-tooltip-size)
+ (setcdr x-max-tooltip-size (max (1+ var) (cdr x-max-tooltip-size))))))
(defclass semantic-displayer-tooltip (semantic-displayer-traditional)
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el
index a3219af7d3e..d63e5bc4869 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -74,7 +74,7 @@ By default, include only headers since the semantic use of EBrowse
is only for searching via semanticdb, and thus only headers would
be searched."
:group 'semanticdb
- :type 'string)
+ :type 'regexp)
;;; SEMANTIC Database related Code
;;; Classes:
@@ -181,7 +181,8 @@ is specified by `semanticdb-default-save-directory'."
"Load all semanticdb controlled EBROWSE caches."
(interactive)
(let ((f (directory-files semanticdb-default-save-directory
- t (concat semanticdb-ebrowse-default-file-name
+ t (concat (regexp-quote
+ semanticdb-ebrowse-default-file-name)
"-load\\.el\\'")
t)))
(while f
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index 510f931fa9f..86ccf28ad02 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -1245,7 +1245,7 @@ See `semanticdb-find-translate-path' for details on PATH.
The argument BRUTISH will be set so that searching includes all tables
in the current project.
FIND-FILE-MATCH indicates that any time a match is found, the file
-associated wit that tag should be loaded into a buffer."
+associated with that tag should be loaded into a buffer."
(semanticdb-find-tags-collector
(lambda (table tags)
(semanticdb-deep-find-tags-by-name-method table name tags))
@@ -1257,7 +1257,7 @@ See `semanticdb-find-translate-path' for details on PATH.
The argument BRUTISH will be set so that searching includes all tables
in the current project.
FIND-FILE-MATCH indicates that any time a match is found, the file
-associated wit that tag should be loaded into a buffer."
+associated with that tag should be loaded into a buffer."
(semanticdb-find-tags-collector
(lambda (table tags)
(semanticdb-deep-find-tags-for-completion-method table prefix tags))
diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el
index 0ab03ef49ef..16a30b6cfbc 100644
--- a/lisp/cedet/semantic/db-mode.el
+++ b/lisp/cedet/semantic/db-mode.el
@@ -69,10 +69,6 @@ database, which can be saved for future Emacs sessions."
(dolist (elt semanticdb-hooks)
(remove-hook (cadr elt) (car elt)))))
-(semantic-varalias-obsolete 'semanticdb-mode-hooks
- 'global-semanticdb-minor-mode-hook "23.2")
-
-
(defun semanticdb-toggle-global-mode ()
"Toggle use of the Semantic Database feature.
Update the environment of Semantic enabled buffers accordingly."
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index aaf43a17293..60a65b195bc 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -89,7 +89,7 @@ same major mode as the current buffer.")
:documentation "The tags belonging to this table.")
(db-refs :initform nil
:documentation
- "List of `semanticdb-table' objects refering to this one.
+ "List of `semanticdb-table' objects referring to this one.
These aren't saved, but are instead recalculated after load.
See the file semanticdb-ref.el for how this slot is used.")
(index :type semanticdb-abstract-search-index
@@ -764,7 +764,7 @@ If a particular major mode wants to search any mode, put the
Do not set the value of this variable permanently.")
(defmacro semanticdb-with-match-any-mode (&rest body)
- "A Semanticdb search occurring withing BODY will search tags in all modes.
+ "A Semanticdb search occurring within BODY will search tags in all modes.
This temporarily sets `semanticdb-match-any-mode' while executing BODY."
(declare (indent 0) (debug t))
`(let ((semanticdb-match-any-mode t))
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el
index 8eb6a3bbd5d..293692000df 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -204,9 +204,6 @@ Also make sure old decorations in the area are completely flushed."
(defvar semantic-decorate-pending-decoration-hook nil
"Normal hook run to perform pending decoration changes.")
-(semantic-varalias-obsolete 'semantic-decorate-pending-decoration-hooks
- 'semantic-decorate-pending-decoration-hook "23.2")
-
(defun semantic-decorate-add-pending-decoration (fcn &optional buffer)
"Add a pending decoration change represented by FCN.
Applies only to the current BUFFER.
diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el
index 47afa25dd74..60ab6033aec 100644
--- a/lisp/cedet/semantic/dep.el
+++ b/lisp/cedet/semantic/dep.el
@@ -183,16 +183,8 @@ macro `defcustom-mode-local-semantic-dependency-system-include-path'."
;;
;; methods for finding files on a provided path.
(defmacro semantic--dependency-find-file-on-path (file path)
- (if (fboundp 'locate-file)
- `(locate-file ,file ,path)
- `(let ((p ,path)
- (found nil))
- (while (and p (not found))
- (let ((f (expand-file-name ,file (car p))))
- (if (file-exists-p f)
- (setq found f)))
- (setq p (cdr p)))
- found)))
+ (declare (obsolete locate-file "28.1"))
+ `(locate-file ,file ,path))
(defvar ede-minor-mode)
(defvar ede-object)
@@ -216,11 +208,11 @@ provided mode, not from the current major mode."
(when (file-exists-p file)
(setq found file))
(when (and (not found) (not systemp))
- (setq found (semantic--dependency-find-file-on-path file locp)))
+ (setq found (locate-file file locp)))
(when (and (not found) edesys)
- (setq found (semantic--dependency-find-file-on-path file edesys)))
+ (setq found (locate-file file edesys)))
(when (not found)
- (setq found (semantic--dependency-find-file-on-path file sysp)))
+ (setq found (locate-file file sysp)))
(if found (expand-file-name found))))
diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el
index 8b39e775789..896bc3bb42e 100644
--- a/lisp/cedet/semantic/doc.el
+++ b/lisp/cedet/semantic/doc.el
@@ -93,8 +93,7 @@ just the lexical token and not the string."
Attempt to strip out comment syntactic sugar.
Argument NOSNARF means don't modify the found text.
If NOSNARF is `lex', then return the lex token."
- (let* ((semantic-ignore-comments nil)
- (semantic-lex-analyzer #'semantic-comment-lexer))
+ (let* ((semantic-lex-analyzer #'semantic-comment-lexer))
(if (memq nosnarf '(lex flex)) ;; keep `flex' for compatibility
(car (semantic-lex (point) (1+ (point))))
(let ((ct (semantic-lex-token-text
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
index 2464833859b..d435ff6b6e9 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -142,19 +142,10 @@ Lays claim to all -by.el, and -wy.el files."
(match-string 1 package)))
(src (ede-expand-filename obj fname))
(csrc (concat (file-name-sans-extension src) ".elc")))
- (if (< emacs-major-version 24)
- ;; Does not have `byte-recompile-file'
- (if (or (not (file-exists-p csrc))
- (file-newer-than-file-p src csrc))
- (progn
- (setq comp (1+ comp))
- (byte-compile-file src))
- (setq utd (1+ utd)))
- ;; Emacs 24 and newer
- (with-no-warnings
- (if (eq (byte-recompile-file src nil 0) t)
- (setq comp (1+ comp))
- (setq utd (1+ utd))))))))
+ (with-no-warnings
+ (if (eq (byte-recompile-file src nil 0) t)
+ (setq comp (1+ comp))
+ (setq utd (1+ utd)))))))
(oref obj source))
(message "All Semantic Grammar sources are up to date in %s" (eieio-object-name obj))
(cons comp utd)))
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index a1225dfeee9..e4319c7d1b3 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -121,9 +121,6 @@ incremental reparse.")
"Hook run after the incremental parser fails.
When this happens, the buffer is marked as needing a full reparse.")
-(semantic-varalias-obsolete 'semantic-edits-incremental-reparse-failed-hooks
- 'semantic-edits-incremental-reparse-failed-hook "23.2")
-
(defcustom semantic-edits-verbose-flag nil
"Non-nil means the incremental parser is verbose.
If nil, errors are still displayed, but informative messages are not."
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 7a1273d6534..c86cd3abf3d 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -68,13 +68,11 @@
;; Since Emacs 22 major mode functions should use `run-mode-hooks' to
;; run major mode hooks.
-(defalias 'semantic-run-mode-hooks
- (if (fboundp 'run-mode-hooks)
- 'run-mode-hooks
- 'run-hooks))
+(define-obsolete-function-alias 'semantic-run-mode-hooks 'run-mode-hooks "28.1")
- ;; Fancy compat usage now handled in cedet-compat
-(defalias 'semantic-subst-char-in-string 'subst-char-in-string)
+;; Fancy compat usage now handled in cedet-compat
+(define-obsolete-function-alias 'semantic-subst-char-in-string
+ 'subst-char-in-string "28.1")
(defun semantic-delete-overlay-maybe (overlay)
"Delete OVERLAY if it is a semantic token overlay."
@@ -175,6 +173,7 @@ Remove self from `post-command-hook' if it is empty."
;;
(defun semantic-overload-symbol-from-function (name)
"Return the symbol for overload used by NAME, the defined symbol."
+ (declare (obsolete define-obsolete-function-alias "28.1"))
(let ((sym-name (symbol-name name)))
(if (string-match "^semantic-" sym-name)
(intern (substring sym-name (match-end 0)))
@@ -184,6 +183,7 @@ Remove self from `post-command-hook' if it is empty."
"Make OLDFNALIAS an alias for NEWFN.
Mark OLDFNALIAS as obsolete, such that the byte compiler
will throw a warning when it encounters this symbol."
+ (declare (obsolete define-obsolete-function-alias "28.1"))
(defalias oldfnalias newfn)
(make-obsolete oldfnalias newfn when)
(when (and (mode-local--function-overload-p newfn)
@@ -198,13 +198,14 @@ will throw a warning when it encounters this symbol."
"%s: `%s' obsoletes overload `%s'"
byte-compile-current-file
newfn
- (semantic-overload-symbol-from-function oldfnalias))
- ))
+ (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function))
+ (semantic-overload-symbol-from-function oldfnalias)))))
(defun semantic-varalias-obsolete (oldvaralias newvar when)
"Make OLDVARALIAS an alias for variable NEWVAR.
Mark OLDVARALIAS as obsolete, such that the byte compiler
will throw a warning when it encounters this symbol."
+ (declare (obsolete define-obsolete-variable-alias "28.1"))
(make-obsolete-variable oldvaralias newvar when)
(condition-case nil
(defvaralias oldvaralias newvar)
@@ -258,9 +259,6 @@ FUNCTION does not have arguments. When FUNCTION is entered
(defalias 'semantic-map-mode-buffers 'mode-local-map-mode-buffers)
-(semantic-alias-obsolete 'define-mode-overload-implementation
- 'define-mode-local-override "23.2")
-
(defun semantic-install-function-overrides (overrides &optional transient)
"Install the function OVERRIDES in the specified environment.
OVERRIDES must be an alist ((OVERLOAD . FUNCTION) ...) where OVERLOAD
@@ -398,13 +396,10 @@ into `mode-local-init-hook'." file filename)
;; "define-lex-regex-type-analyzer"
;; "define-lex-string-type-analyzer"
;; "define-lex-block-type-analyzer"
-;; ;;"define-mode-overload-implementation"
;; ;;"define-semantic-child-mode"
;; "define-semantic-idle-service"
;; "define-semantic-decoration-style"
;; "define-wisent-lexer"
-;; "semantic-alias-obsolete"
-;; "semantic-varalias-obsolete"
;; "semantic-make-obsolete-overload"
;; "defcustom-mode-local-semantic-dependency-system-include-path"
;; ))
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 62c86f9d12d..f71ac6c413e 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -142,7 +142,7 @@ It ignores whitespaces, newlines and comments."
"Return expansion of built-in ASSOC expression.
ARGS are ASSOC's key value list."
(let ((key t))
- `(semantic-tag-make-assoc-list
+ `(semantic-tag-make-plist
,@(mapcar #'(lambda (i)
(prog1
(if key
@@ -1251,6 +1251,7 @@ common grammar menu."
"Setup an XEmacs grammar menu in variable SYMBOL.
MODE-MENU is an optional specific menu whose items are appended to the
common grammar menu."
+ (declare (obsolete nil "28.1"))
(let ((items (make-symbol "items"))
(path (make-symbol "path")))
`(progn
@@ -1306,7 +1307,7 @@ the change bounds to encompass the whole nonterminal tag."
;; Look within the line for a ; following an even number of backslashes
;; after either a non-backslash or the line beginning.
(set (make-local-variable 'comment-start-skip)
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
(set (make-local-variable 'indent-line-function)
'semantic-grammar-indent)
(set (make-local-variable 'fill-paragraph-function)
@@ -1663,6 +1664,42 @@ Select the buffer containing the tag's definition, and move point there."
(defvar semantic-grammar-eldoc-last-data (cons nil nil))
+(defun semantic--docstring-format-sym-doc (prefix doc &optional face)
+ "Combine PREFIX and DOC, and shorten the result to fit in the echo area.
+
+When PREFIX is a symbol, propertize its symbol name with FACE
+before combining it with DOC. If FACE is not provided, just
+apply the nil face.
+
+See also: `eldoc-echo-area-use-multiline-p'."
+ ;; Hoisted from old `eldoc-docstring-format-sym-doc'.
+ ;; If the entire line cannot fit in the echo area, the symbol name may be
+ ;; truncated or eliminated entirely from the output to make room for the
+ ;; description.
+ (when (symbolp prefix)
+ (setq prefix (concat (propertize (symbol-name prefix) 'face face) ": ")))
+ (let* ((ea-multi eldoc-echo-area-use-multiline-p)
+ ;; Subtract 1 from window width since emacs will not write
+ ;; any chars to the last column, or in later versions, will
+ ;; cause a wraparound and resize of the echo area.
+ (ea-width (1- (window-width (minibuffer-window))))
+ (strip (- (+ (length prefix)
+ (length doc))
+ ea-width)))
+ (cond ((or (<= strip 0)
+ (eq ea-multi t)
+ (and ea-multi (> (length doc) ea-width)))
+ (concat prefix doc))
+ ((> (length doc) ea-width)
+ (substring (format "%s" doc) 0 ea-width))
+ ((>= strip (string-match-p ":? *\\'" prefix))
+ doc)
+ (t
+ ;; Show the end of the partial symbol name, rather
+ ;; than the beginning, since the former is more likely
+ ;; to be unique given package namespace conventions.
+ (concat (substring prefix strip) doc)))))
+
(defun semantic-grammar-eldoc-get-macro-docstring (macro expander)
"Return a one-line docstring for the given grammar MACRO.
EXPANDER is the name of the function that expands MACRO."
@@ -1681,19 +1718,18 @@ EXPANDER is the name of the function that expands MACRO."
(setq doc (eldoc-function-argstring expander))))
(when doc
(setq doc
- (eldoc-docstring-format-sym-doc
+ (semantic--docstring-format-sym-doc
macro (format "==> %s %s" expander doc) 'default))
(setq semantic-grammar-eldoc-last-data (cons expander doc)))
doc))
((fboundp 'elisp-get-fnsym-args-string) ;; Emacs≥25
- (elisp-get-fnsym-args-string
- expander nil
- (concat (propertize (symbol-name macro)
+ (concat (propertize (symbol-name macro)
'face 'font-lock-keyword-face)
" ==> "
(propertize (symbol-name macro)
'face 'font-lock-function-name-face)
- ": ")))))
+ ": "
+ (elisp-get-fnsym-args-string expander nil )))))
(define-mode-local-override semantic-idle-summary-current-symbol-info
semantic-grammar-mode ()
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 76218249c59..8301b195309 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -472,11 +472,6 @@ This hook is not protected from lexical errors.")
If any hook function throws an error, this variable is reset to nil.
This hook is not protected from lexical errors.")
-(semantic-varalias-obsolete 'semantic-before-idle-scheduler-reparse-hooks
- 'semantic-before-idle-scheduler-reparse-hook "23.2")
-(semantic-varalias-obsolete 'semantic-after-idle-scheduler-reparse-hooks
- 'semantic-after-idle-scheduler-reparse-hook "23.2")
-
(defun semantic-idle-scheduler-refresh-tags ()
"Refreshes the current buffer's tags.
This is called by `semantic-idle-scheduler-function' to update the
@@ -734,10 +729,6 @@ specific to a major mode. For example, in jde mode:
(define-overloadable-function semantic-idle-summary-current-symbol-info ()
"Return a string message describing the current context.")
-(make-obsolete-overload 'semantic-eldoc-current-symbol-info
- 'semantic-idle-summary-current-symbol-info
- "23.2")
-
(defcustom semantic-idle-summary-mode-hook nil
"Hook run at the end of `semantic-idle-summary'."
:group 'semantic
diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el
index 19e0515ac63..25f7fdb8426 100644
--- a/lisp/cedet/semantic/imenu.el
+++ b/lisp/cedet/semantic/imenu.el
@@ -44,9 +44,8 @@
;; Because semantic imenu tags will hose the current imenu handling
;; code in speedbar, force semantic/sb in.
-(if (featurep 'speedbar)
- (require 'semantic/sb)
- (add-hook 'speedbar-load-hook (lambda () (require 'semantic/sb))))
+(with-eval-after-load 'speedbar
+ (require 'semantic/sb))
(defgroup semantic-imenu nil
"Semantic interface to Imenu."
@@ -89,8 +88,6 @@ This option is ignored if `semantic-imenu-bucketize-file' is nil."
:group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-expand-type-members)
-(semantic-varalias-obsolete 'semantic-imenu-expand-type-parts
- 'semantic-imenu-expand-type-members "23.2")
(defcustom semantic-imenu-bucketize-type-members t
"Non-nil if members of a type should be grouped into buckets.
@@ -99,8 +96,6 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil."
:group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-bucketize-type-members)
-(semantic-varalias-obsolete 'semantic-imenu-bucketize-type-parts
- 'semantic-imenu-bucketize-type-members "23.2")
(defcustom semantic-imenu-sort-bucket-function nil
"Function to use when sorting tags in the buckets of functions.
@@ -146,8 +141,6 @@ Tags of those classes will be given submenu with children.
By default, a `type' has interesting children. In Texinfo, however, a
`section' has interesting children.")
(make-variable-buffer-local 'semantic-imenu-expandable-tag-classes)
-(semantic-varalias-obsolete 'semantic-imenu-expandable-token
- 'semantic-imenu-expandable-tag-classes "23.2")
;;; Code:
(defun semantic-imenu-tag-overlay (tag)
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index 80d03dc629b..cc53f69691b 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -253,9 +253,6 @@ Optional argument COLOR indicates that color should be mixed in."
'semantic-format-tag-prototype-default)
tag parent color)))
-(semantic-alias-obsolete 'semantic-java-prototype-nonterminal
- 'semantic-format-tag-prototype-java-mode "23.2")
-
;; Include Tag Name
;;
@@ -324,7 +321,7 @@ If NOSNARF is `lex', then return the semantic lex token."
(defvar semantic-java-doc-line-tags nil
"Valid javadoc line tags.
Ordered following Sun's Tag Convention at
-<http://java.sun.com/products/jdk/javadoc/writingdoccomments/index.html>")
+<https://java.sun.com/products/jdk/javadoc/writingdoccomments/index.html>")
(defvar semantic-java-doc-with-name-tags nil
"Javadoc tags which have a name.")
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index b8812de05b6..e6e124eb812 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -70,7 +70,7 @@
(require 'semantic)
(require 'semantic/lex)
-(declare-function semantic-c-end-of-macro "semantic/bovine/c")
+(declare-function c-end-of-macro "cc-engine")
;;; Code:
(defvar semantic-lex-spp-macro-symbol-obarray nil
@@ -946,7 +946,7 @@ by another macro."
(save-excursion
(let ((start (match-beginning 0))
(end (match-end 0))
- (peom (save-excursion (semantic-c-end-of-macro) (point))))
+ (peom (save-excursion (c-end-of-macro) (point))))
(condition-case nil
(progn
;; This will throw an error if no closing paren can be found.
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 500a09d492f..809271ddccd 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1069,7 +1069,7 @@ Only in effect if `debug-on-error' is also non-nil."
"For SYNTAX, execute FORMS with protection for unterminated syntax.
If FORMS throws an error, treat this as a syntax problem, and
execute the unterminated syntax code. FORMS should return a position.
-Irregardless of an error, the cursor should be moved to the end of
+Regardless of an error, the cursor should be moved to the end of
the desired syntax, and a position returned.
If `debug-on-error' is set, errors are not caught, so that you can
debug them.
@@ -1701,9 +1701,6 @@ If there is no error, then the last value of FORMS is returned."
`(let* ((semantic-lex-unterminated-syntax-end-function
(lambda (,syntax ,start ,end)
(throw ',symbol ,syntax)))
- ;; Delete the below when semantic-flex is fully retired.
- (semantic-flex-unterminated-syntax-end-function
- semantic-lex-unterminated-syntax-end-function)
(,ret (catch ',symbol
(save-excursion
,@forms
@@ -1751,32 +1748,12 @@ If there is no error, then the last value of FORMS is returned."
))
;;; Compatibility with Semantic 1.x lexical analysis
-;;
-;; NOTE: DELETE THIS SOMEDAY SOON
-
-(semantic-alias-obsolete 'semantic-flex-start 'semantic-lex-token-start "23.2")
-(semantic-alias-obsolete 'semantic-flex-end 'semantic-lex-token-end "23.2")
-(semantic-alias-obsolete 'semantic-flex-text 'semantic-lex-token-text "23.2")
-(semantic-alias-obsolete 'semantic-flex-make-keyword-table 'semantic-lex-make-keyword-table "23.2")
-(semantic-alias-obsolete 'semantic-flex-keyword-p 'semantic-lex-keyword-p "23.2")
-(semantic-alias-obsolete 'semantic-flex-keyword-put 'semantic-lex-keyword-put "23.2")
-(semantic-alias-obsolete 'semantic-flex-keyword-get 'semantic-lex-keyword-get "23.2")
-(semantic-alias-obsolete 'semantic-flex-map-keywords 'semantic-lex-map-keywords "23.2")
-(semantic-alias-obsolete 'semantic-flex-keywords 'semantic-lex-keywords "23.2")
-(semantic-alias-obsolete 'semantic-flex-buffer 'semantic-lex-buffer "23.2")
-(semantic-alias-obsolete 'semantic-flex-list 'semantic-lex-list "23.2")
-
-;; This simple scanner uses the syntax table to generate a stream of
-;; simple tokens of the form:
-;;
-;; (SYMBOL START . END)
-;;
-;; Where symbol is the type of thing it is. START and END mark that
-;; objects boundary.
(defvar semantic-flex-tokens semantic-lex-tokens
"An alist of semantic token types.
See variable `semantic-lex-tokens'.")
+(make-obsolete-variable 'semantic-flex-tokens
+ 'semantic-lex-tokens "28.1")
(defvar semantic-flex-unterminated-syntax-end-function
(lambda (_syntax _syntax-start flex-end) flex-end)
@@ -1788,6 +1765,8 @@ FLEX-END is where the lexical analysis was asked to end.
This function can be used for languages that can intelligently fix up
broken syntax, or the exit lexical analysis via `throw' or `signal'
when finding unterminated syntax.")
+(make-obsolete-variable 'semantic-flex-unterminated-syntax-end-function
+ nil "28.1")
(defvar semantic-flex-extensions nil
"Buffer local extensions to the lexical analyzer.
@@ -1799,6 +1778,7 @@ nil is also a valid return value.
TYPE can be any type of symbol, as long as it doesn't occur as a
nonterminal in the language definition.")
(make-variable-buffer-local 'semantic-flex-extensions)
+(make-obsolete-variable 'semantic-flex-extensions nil "28.1")
(defvar semantic-flex-syntax-modifications nil
"Changes to the syntax table for this buffer.
@@ -1809,237 +1789,47 @@ CHAR is the char passed to `modify-syntax-entry',
and CLASS is the string also passed to `modify-syntax-entry' to define
what syntax class CHAR has.")
(make-variable-buffer-local 'semantic-flex-syntax-modifications)
+(make-obsolete-variable 'semantic-flex-syntax-modifications nil "28.1")
(defvar semantic-ignore-comments t
"Default comment handling.
The value t means to strip comments when flexing; nil means
to keep comments as part of the token stream.")
(make-variable-buffer-local 'semantic-ignore-comments)
+(make-obsolete-variable 'semantic-ignore-comments nil "28.1")
(defvar semantic-flex-enable-newlines nil
"When flexing, report newlines as syntactic elements.
Useful for languages where the newline is a special case terminator.
Only set this on a per mode basis, not globally.")
(make-variable-buffer-local 'semantic-flex-enable-newlines)
+(make-obsolete-variable 'semantic-flex-enable-newlines nil "28.1")
(defvar semantic-flex-enable-whitespace nil
"When flexing, report whitespace as syntactic elements.
Useful for languages where the syntax is whitespace dependent.
Only set this on a per mode basis, not globally.")
(make-variable-buffer-local 'semantic-flex-enable-whitespace)
+(make-obsolete-variable 'semantic-flex-enable-whitespace nil "28.1")
(defvar semantic-flex-enable-bol nil
"When flexing, report beginning of lines as syntactic elements.
Useful for languages like python which are indentation sensitive.
Only set this on a per mode basis, not globally.")
(make-variable-buffer-local 'semantic-flex-enable-bol)
+(make-obsolete-variable 'semantic-flex-enable-bol nil "28.1")
(defvar semantic-number-expression semantic-lex-number-expression
"See variable `semantic-lex-number-expression'.")
(make-variable-buffer-local 'semantic-number-expression)
+(make-obsolete-variable 'semantic-number-expression
+ 'semantic-lex-number-expression "28.1")
(defvar semantic-flex-depth 0
"Default flexing depth.
This specifies how many lists to create tokens in.")
(make-variable-buffer-local 'semantic-flex-depth)
-
-(defun semantic-flex (start end &optional depth length)
- "Using the syntax table, do something roughly equivalent to flex.
-Semantically check between START and END. Optional argument DEPTH
-indicates at what level to scan over entire lists.
-The return value is a token stream. Each element is a list, such of
-the form (symbol start-expression . end-expression) where SYMBOL
-denotes the token type.
-See `semantic-flex-tokens' variable for details on token types.
-END does not mark the end of the text scanned, only the end of the
-beginning of text scanned. Thus, if a string extends past END, the
-end of the return token will be larger than END. To truly restrict
-scanning, use `narrow-to-region'.
-The last argument, LENGTH specifies that `semantic-flex' should only
-return LENGTH tokens."
- (declare (obsolete define-lex "23.2"))
- (if (not semantic-flex-keywords-obarray)
- (setq semantic-flex-keywords-obarray [ nil ]))
- (let ((ts nil)
- (pos (point))
- (ep nil)
- (curdepth 0)
- (cs (if comment-start-skip
- (concat "\\(\\s<\\|" comment-start-skip "\\)")
- (concat "\\(\\s<\\)")))
- (newsyntax (copy-syntax-table (syntax-table)))
- (mods semantic-flex-syntax-modifications)
- ;; Use the default depth if it is not specified.
- (depth (or depth semantic-flex-depth)))
- ;; Update the syntax table
- (while mods
- (modify-syntax-entry (car (car mods)) (car (cdr (car mods))) newsyntax)
- (setq mods (cdr mods)))
- (with-syntax-table newsyntax
- (goto-char start)
- (while (and (< (point) end) (or (not length) (<= (length ts) length)))
- (cond
- ;; catch beginning of lines when needed.
- ;; Must be done before catching any other tokens!
- ((and semantic-flex-enable-bol
- (bolp)
- ;; Just insert a (bol N . N) token in the token stream,
- ;; without moving the point. N is the point at the
- ;; beginning of line.
- (setq ts (cons (cons 'bol (cons (point) (point))) ts))
- nil)) ;; CONTINUE
- ;; special extensions, includes whitespace, nl, etc.
- ((and semantic-flex-extensions
- (let ((fe semantic-flex-extensions)
- (r nil))
- (while fe
- (if (looking-at (car (car fe)))
- (setq ts (cons (funcall (cdr (car fe))) ts)
- r t
- fe nil
- ep (point)))
- (setq fe (cdr fe)))
- (if (and r (not (car ts))) (setq ts (cdr ts)))
- r)))
- ;; catch newlines when needed
- ((looking-at "\\s-*\\(\n\\|\\s>\\)")
- (if semantic-flex-enable-newlines
- (setq ep (match-end 1)
- ts (cons (cons 'newline
- (cons (match-beginning 1) ep))
- ts))))
- ;; catch whitespace when needed
- ((looking-at "\\s-+")
- (if semantic-flex-enable-whitespace
- ;; Language wants whitespaces, link them together.
- (if (eq (car (car ts)) 'whitespace)
- (setcdr (cdr (car ts)) (match-end 0))
- (setq ts (cons (cons 'whitespace
- (cons (match-beginning 0)
- (match-end 0)))
- ts)))))
- ;; numbers
- ((and semantic-number-expression
- (looking-at semantic-number-expression))
- (setq ts (cons (cons 'number
- (cons (match-beginning 0)
- (match-end 0)))
- ts)))
- ;; symbols
- ((looking-at "\\(\\sw\\|\\s_\\)+")
- (setq ts (cons (cons
- ;; Get info on if this is a keyword or not
- (or (semantic-lex-keyword-p (match-string 0))
- 'symbol)
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- ;; Character quoting characters (ie, \n as newline)
- ((looking-at "\\s\\+")
- (setq ts (cons (cons 'charquote
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- ;; Open parens, or semantic-lists.
- ((looking-at "\\s(")
- (if (or (not depth) (< curdepth depth))
- (progn
- (setq curdepth (1+ curdepth))
- (setq ts (cons (cons 'open-paren
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- (setq ts (cons
- (cons 'semantic-list
- (cons (match-beginning 0)
- (save-excursion
- (condition-case nil
- (forward-list 1)
- ;; This case makes flex robust
- ;; to broken lists.
- (error
- (goto-char
- (funcall
- semantic-flex-unterminated-syntax-end-function
- 'semantic-list
- start end))))
- (setq ep (point)))))
- ts))))
- ;; Close parens
- ((looking-at "\\s)")
- (setq ts (cons (cons 'close-paren
- (cons (match-beginning 0) (match-end 0)))
- ts))
- (setq curdepth (1- curdepth)))
- ;; String initiators
- ((looking-at "\\s\"")
- ;; Zing to the end of this string.
- (setq ts (cons (cons 'string
- (cons (match-beginning 0)
- (save-excursion
- (condition-case nil
- (forward-sexp 1)
- ;; This case makes flex
- ;; robust to broken strings.
- (error
- (goto-char
- (funcall
- semantic-flex-unterminated-syntax-end-function
- 'string
- start end))))
- (setq ep (point)))))
- ts)))
- ;; comments
- ((looking-at cs)
- (if (and semantic-ignore-comments
- (not semantic-flex-enable-whitespace))
- ;; If the language doesn't deal with comments nor
- ;; whitespaces, ignore them here.
- (let ((comment-start-point (point)))
- (forward-comment 1)
- (if (eq (point) comment-start-point)
- ;; In this case our start-skip string failed
- ;; to work properly. Lets try and move over
- ;; whatever white space we matched to begin
- ;; with.
- (skip-syntax-forward "-.'" (point-at-eol))
- ;;(forward-comment 1)
- ;; Generate newline token if enabled
- (if (and semantic-flex-enable-newlines
- (bolp))
- (backward-char 1)))
- (if (eq (point) comment-start-point)
- (error "Strange comment syntax prevents lexical analysis"))
- (setq ep (point)))
- (let ((tk (if semantic-ignore-comments 'whitespace 'comment)))
- (save-excursion
- (forward-comment 1)
- ;; Generate newline token if enabled
- (if (and semantic-flex-enable-newlines
- (bolp))
- (backward-char 1))
- (setq ep (point)))
- ;; Language wants comments or want them as whitespaces,
- ;; link them together.
- (if (eq (car (car ts)) tk)
- (setcdr (cdr (car ts)) ep)
- (setq ts (cons (cons tk (cons (match-beginning 0) ep))
- ts))))))
- ;; punctuation
- ((looking-at "\\(\\s.\\|\\s$\\|\\s'\\)")
- (setq ts (cons (cons 'punctuation
- (cons (match-beginning 0) (match-end 0)))
- ts)))
- ;; unknown token
- (t
- (error "What is that?")))
- (goto-char (or ep (match-end 0)))
- (setq ep nil)))
- ;; maybe catch the last beginning of line when needed
- (and semantic-flex-enable-bol
- (= (point) end)
- (bolp)
- (setq ts (cons (cons 'bol (cons (point) (point))) ts)))
- (goto-char pos)
- ;;(message "Flexing muscles...done")
- (nreverse ts)))
+(make-obsolete-variable 'semantic-flex-depth nil "28.1")
(provide 'semantic/lex)
diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el
index 23f5f89274f..fc7f9dbcb64 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -85,10 +85,12 @@ current project to find references to the input SYM. The
references are the organized by file and the name of the function
they are used in.
Display the references in `semantic-symref-results-mode'."
- (interactive (list (let ((tag (semantic-current-tag)))
- (read-string " Symrefs for: " nil nil
- (when tag
- (regexp-quote (semantic-tag-name tag)))))))
+ (interactive (list (let* ((tag (semantic-current-tag))
+ (default (when tag
+ (regexp-quote
+ (semantic-tag-name tag)))))
+ (read-string (format-prompt " Symrefs for" default)
+ nil nil default))))
;; FIXME: Shouldn't the input be in Emacs regexp format, for
;; consistency? Converting it to extended is not hard.
(semantic-fetch-tags)
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
index 50d43fe9342..23f4b29cbd6 100644
--- a/lisp/cedet/semantic/tag-file.el
+++ b/lisp/cedet/semantic/tag-file.el
@@ -101,9 +101,6 @@ PARENT can also be a `semanticdb-table' object."
)
)
-(make-obsolete-overload 'semantic-find-nonterminal
- 'semantic-go-to-tag "23.2")
-
;;; Dependencies
;;
;; A tag which is of type 'include specifies a dependency.
@@ -175,9 +172,6 @@ Depends on `semantic-dependency-include-path' for searching. Always searches
nil)
)))
-(make-obsolete-overload 'semantic-find-dependency
- 'semantic-dependency-tag-file "23.2")
-
;;; PROTOTYPE FILE
;;
;; In C, a function in the .c file often has a representation in a
@@ -199,13 +193,6 @@ file prototypes belong in."
(if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t)
(match-string 1))))))
-(semantic-alias-obsolete 'semantic-find-nonterminal
- 'semantic-go-to-tag "23.2")
-
-(semantic-alias-obsolete 'semantic-find-dependency
- 'semantic-dependency-tag-file "23.2")
-
-
(provide 'semantic/tag-file)
;; Local variables:
diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el
index 16179a53cd5..3ee11df7d8e 100644
--- a/lisp/cedet/semantic/tag-ls.el
+++ b/lisp/cedet/semantic/tag-ls.el
@@ -190,7 +190,7 @@ See `semantic-tag-similar-p' for details."
;; will contain the info needed to determine the full name.
(define-overloadable-function semantic-tag-full-package (tag &optional stream-or-buffer)
"Return the fully qualified package name of TAG in a package hierarchy.
-STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream',
+STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-tag-table',
but must be a toplevel semantic tag stream that contains TAG.
A Package Hierarchy is defined in UML by the way classes and methods
are organized on disk. Some languages use this concept such that a
@@ -213,7 +213,7 @@ Return the name of the first tag of class `package' in STREAM."
(define-overloadable-function semantic-tag-full-name (tag &optional stream-or-buffer)
"Return the fully qualified name of TAG in the package hierarchy.
-STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream',
+STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-tag-table',
but must be a toplevel semantic tag stream that contains TAG.
A Package Hierarchy is defined in UML by the way classes and methods
are organized on disk. Some languages use this concept such that a
@@ -233,9 +233,6 @@ resolve issues where a method in a class in a package is present."
(or stream-or-buffer tag))))
(:override-with-args (tag stream))))
-(make-obsolete-overload 'semantic-nonterminal-full-name
- 'semantic-tag-full-name "23.2")
-
(defun semantic-tag-full-name-default (tag stream)
"Default method for `semantic-tag-full-name'.
Return the name of TAG found in the toplevel STREAM."
@@ -287,9 +284,6 @@ is to return a symbol based on type modifiers."
(setq parent (semantic-tag-calculate-parent tag)))
(:override))
-(make-obsolete-overload 'semantic-nonterminal-protection
- 'semantic-tag-protection "23.2")
-
(defun semantic-tag-protection-default (tag &optional parent)
"Return the protection of TAG as a child of PARENT default action.
See `semantic-tag-protection'."
@@ -377,9 +371,6 @@ in how methods are overridden. In UML, abstract methods are italicized.
The default behavior (if not overridden with `tag-abstract-p'
is to return true if `abstract' is in the type modifiers.")
-(make-obsolete-overload 'semantic-nonterminal-abstract
- 'semantic-tag-abstract-p "23.2")
-
(defun semantic-tag-abstract-p-default (tag &optional parent)
"Return non-nil if TAG is abstract as a child of PARENT default action.
See `semantic-tag-abstract-p'."
@@ -400,9 +391,6 @@ In UML, leaf methods and classes have special meaning and behavior.
The default behavior (if not overridden with `tag-leaf-p'
is to return true if `leaf' is in the type modifiers.")
-(make-obsolete-overload 'semantic-nonterminal-leaf
- 'semantic-tag-leaf-p "23.2")
-
(defun semantic-tag-leaf-p-default (tag &optional parent)
"Return non-nil if TAG is leaf as a child of PARENT default action.
See `semantic-tag-leaf-p'."
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index ca5c068d348..e677264c5a9 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -1328,26 +1328,6 @@ This function is overridable with the symbol `insert-foreign-tag'."
(defconst semantic-token-incompatible-version
semantic-tag-incompatible-version)
-(defsubst semantic-token-type-parent (tag)
- "Return the parent of the type that TAG describes.
-The return value is a list. A value of nil means no parents.
-The `car' of the list is either the parent class, or a list
-of parent classes. The `cdr' of the list is the list of
-interfaces, or abstract classes which are parents of TAG."
- (cons (semantic-tag-get-attribute tag :superclasses)
- (semantic-tag-type-interfaces tag)))
-
-(make-obsolete 'semantic-token-type-parent
- "\
-use `semantic-tag-type-superclass' \
-and `semantic-tag-type-interfaces' instead" "23.2")
-
-(semantic-alias-obsolete 'semantic-tag-make-assoc-list
- 'semantic-tag-make-plist "23.2")
-
-(semantic-varalias-obsolete 'semantic-expand-nonterminal
- 'semantic-tag-expand-function "23.2")
-
(provide 'semantic/tag)
;; Local variables:
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index c64d56b2e21..7df7dfcb75f 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -79,9 +79,6 @@ If FILE is not loaded, and semanticdb is not available, find the file
(with-current-buffer (find-file-noselect file)
(semantic-fetch-tags))))))
-(semantic-alias-obsolete 'semantic-file-token-stream
- 'semantic-file-tag-table "23.2")
-
(declare-function semanticdb-abstract-table-child-p "semantic/db" (obj) t)
(declare-function semanticdb-refresh-table "semantic/db")
(declare-function semanticdb-get-tags "semantic/db" (arg &rest args) t)
@@ -137,9 +134,6 @@ buffer, or a filename. If SOMETHING is nil return nil."
;; don't know what it is
(t nil)))
-(semantic-alias-obsolete 'semantic-something-to-stream
- 'semantic-something-to-tag-table "23.2")
-
;;; Completion APIs
;;
;; These functions provide minibuffer reading/completion for lists of
@@ -307,7 +301,6 @@ If TAG is not specified, use the tag at point."
semantic-init-db-hook
semantic-unmatched-syntax-hook
semantic--before-fetch-tags-hook
- semantic-after-toplevel-bovinate-hook
semantic-after-toplevel-cache-change-hook
semantic-before-toplevel-cache-flush-hook
semantic-dump-parse
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index 527a35c9ae1..15d1313dfa4 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -43,11 +43,6 @@
"Extra lookahead token.
When non-nil it is directly returned by `wisent-lex-function'.")
-;; Maintain this alias for compatibility until all WY grammars have
-;; been translated again to Elisp code.
-(semantic-alias-obsolete 'wisent-lex-make-token-table
- 'semantic-lex-make-type-table "23.2")
-
(defmacro wisent-lex-eoi ()
"Return an End-Of-Input lexical token.
The EOI token is like this: ($EOI \"\" POINT-MAX . POINT-MAX)."
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index 4e9927f23f1..42c5756b987 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -3053,7 +3053,7 @@ one.")
(defsubst wisent-ISVALID-TOKEN (x)
"Return non-nil if X is a character or an allowed symbol."
- (or (wisent-char-p x)
+ (or (characterp x)
(wisent-ISVALID-VAR x)))
(defun wisent-push-token (symbol &optional nocheck)
@@ -3143,7 +3143,7 @@ the rule."
(cond
((or (memq item token-list) (memq item var-list)))
;; Create new literal character token
- ((wisent-char-p item) (wisent-push-token item t))
+ ((characterp item) (wisent-push-token item t))
((error "Symbol `%s' is used, but is not defined as a token and has no rules"
item))))
(setq rhl (1+ rhl)
diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el
index 49b0fd1b3b4..0ff9cde80ef 100644
--- a/lisp/cedet/semantic/wisent/grammar.el
+++ b/lisp/cedet/semantic/wisent/grammar.el
@@ -427,7 +427,7 @@ Menu items are appended to the common grammar menu.")
"\n;; It is derived from the grammar in the ECMAScript Language
;; Specification published at
;;
-;; http://www.ecma-international.org/publications/standards/Ecma-262.htm
+;; https://www.ecma-international.org/publications/standards/Ecma-262.htm
;;
;; and redistributed under the following license:
;;
diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el
index d8a35d3e7d3..a0a8bed1eaf 100644
--- a/lisp/cedet/semantic/wisent/wisent.el
+++ b/lisp/cedet/semantic/wisent/wisent.el
@@ -55,11 +55,8 @@
;;;; Runtime stuff
;;;; -------------
-;;; Compatibility
-(eval-and-compile
- (if (fboundp 'char-valid-p)
- (defalias 'wisent-char-p 'char-valid-p)
- (defalias 'wisent-char-p 'char-or-char-int-p)))
+(define-obsolete-function-alias 'wisent-char-p
+ #'characterp "28.1")
;;; Printed representation of terminals and nonterminals
(defconst wisent-escape-sequence-strings
@@ -80,7 +77,7 @@
(defsubst wisent-item-to-string (item)
"Return a printed representation of ITEM.
ITEM can be a nonterminal or terminal symbol, or a character literal."
- (if (wisent-char-p item)
+ (if (characterp item)
(or (cdr (assq item wisent-escape-sequence-strings))
(format "'%c'" item))
(symbol-name item)))
diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el
index eb7af1c2727..79c8afff348 100644
--- a/lisp/cedet/srecode.el
+++ b/lisp/cedet/srecode.el
@@ -1,4 +1,4 @@
-;;; srecode.el --- Semantic buffer evaluator.
+;;; srecode.el --- Semantic buffer evaluator. -*- lexical-binding: t -*-
;;; Copyright (C) 2005, 2007-2020 Free Software Foundation, Inc.
diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el
index 4151b17c885..fdb44695918 100644
--- a/lisp/cedet/srecode/document.el
+++ b/lisp/cedet/srecode/document.el
@@ -89,7 +89,7 @@ versions of names. This is an alist with each element of the form:
MATCH is a regexp to match in the type field.
RESULT is a string."
:group 'document
- :type '(repeat (cons (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-function-alist
@@ -145,7 +145,7 @@ see how best to describe what can be returned.
Doesn't always work correctly, but that is just because English
doesn't always work correctly."
:group 'document
- :type '(repeat (cons (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-common-nouns-abbrevs
@@ -176,7 +176,7 @@ versions of names. This is an alist with each element of the form:
MATCH is a regexp to match in the type field.
RESULT is a string."
:group 'document
- :type '(repeat (cons (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-return-first-alist
@@ -193,7 +193,7 @@ This is an alist with each element of the form:
MATCH is a regexp to match in the type field.
RESULT is a string."
:group 'document
- :type '(repeat (cons (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-return-last-alist
@@ -214,7 +214,7 @@ MATCH is a regexp to match in the type field.
RESULT is a string, which can contain %s, which is replaced with
`match-string' 1."
:group 'document
- :type '(repeat (cons (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-param-alist
@@ -234,7 +234,7 @@ RESULT is a string of text to use to describe MATCH.
When one is encountered, document-insert-parameters will automatically
place this comment after the parameter name."
:group 'document
- :type '(repeat (cons (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
(defcustom srecode-document-autocomment-param-type-alist
@@ -259,7 +259,7 @@ This is an alist with each element of the form:
MATCH is a regexp to match in the type field.
RESULT is a string."
:group 'document
- :type '(repeat (cons (string :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
;;;###autoload
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el
index e46c5820c55..87c7c684dab 100644
--- a/lisp/cedet/srecode/fields.el
+++ b/lisp/cedet/srecode/fields.el
@@ -164,7 +164,7 @@ Has virtual :start and :end initializers.")
(cl-defmethod srecode-overlaid-text ((olaid srecode-overlaid) &optional set-to)
"Return the text under OLAID.
-If SET-TO is a string, then replace the text of OLAID wit SET-TO."
+If SET-TO is a string, then replace the text of OLAID with SET-TO."
(let* ((ol (oref olaid overlay))
(start (overlay-start ol)))
(if (not (stringp set-to))
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index 26c14892efd..5b2dd034743 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -201,7 +201,7 @@ variable default values, and other things."
(let ((tag (or srecode-semantic-selected-tag
(srecode-semantic-tag-from-kill-ring))))
(when (not tag)
- "No tag for current template. Use the semantic kill-ring.")
+ (error "No tag for current template. Use the semantic kill-ring."))
(srecode-semantic-apply-tag-to-dict
(srecode-semantic-tag (semantic-tag-name tag)
:prime tag)
diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index 6b8c3034a4c..4c1e030fceb 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -195,7 +195,7 @@ we can tell font lock about them.")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'comment-start-skip)
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
(set (make-local-variable 'font-lock-defaults)
'(srecode-font-lock-keywords
nil ;; perform string/comment fontification
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index f8a303956e3..34561a2efe6 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -324,6 +324,13 @@ from which to start."
(while (< i end)
(pcase (aref string i)
(?\s (setq spaces (1+ spaces)))
+ ((pred (lambda (c) (and char-fold-symmetric
+ (if isearch-regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)
+ (stringp search-whitespace-regexp)
+ (string-match-p search-whitespace-regexp (char-to-string c)))))
+ (setq spaces (1+ spaces)))
(c (when (> spaces 0)
(push (char-fold--make-space-string spaces) out)
(setq spaces 0))
@@ -370,11 +377,7 @@ from which to start."
(setq i (1+ i)))
(when (> spaces 0)
(push (char-fold--make-space-string spaces) out))
- (let ((regexp (apply #'concat (nreverse out))))
- ;; Limited by `MAX_BUF_SIZE' in `regex-emacs.c'.
- (if (> (length regexp) 5000)
- (regexp-quote string)
- regexp))))
+ (apply #'concat (nreverse out))))
;;; Commands provided for completeness.
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index d590b9ecf61..7191b933e41 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -327,9 +327,8 @@ With a prefix argument switch off tracing of procedure PROC."
(interactive
(list (let ((current (symbol-at-point))
(action (if current-prefix-arg "Untrace" "Trace")))
- (if current
- (read-string (format "%s procedure [%s]: " action current) nil nil (symbol-name current))
- (read-string (format "%s procedure: " action))))
+ (read-string (format-prompt "%s procedure" current action)
+ nil nil (and current (symbol-name current))))
current-prefix-arg))
(when (= (length proc) 0)
(error "Invalid procedure name"))
@@ -517,6 +516,8 @@ command to run."
This is a good place to put keybindings."
:type 'hook
:group 'cmuscheme)
+(make-obsolete-variable 'cmuscheme-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'cmuscheme-load-hook)
diff --git a/lisp/comint.el b/lisp/comint.el
index 3e76c5d02b0..2873416c5f4 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -223,6 +223,13 @@ This variable is buffer-local."
(other :tag "on" t))
:group 'comint)
+(defcustom comint-highlight-input t
+ "If non-nil, highlight input with `comint-highlight-input' face.
+Otherwise keep the original highlighting untouched."
+ :version "28.1"
+ :type 'boolean
+ :group 'comint)
+
(defface comint-highlight-input '((t (:weight bold)))
"Face to use to highlight user input."
:group 'comint)
@@ -249,6 +256,10 @@ to set this in a mode hook, rather than customize the default value."
file)
:group 'comint)
+(defvar comint-input-ring-file-prefix nil
+ "The prefix to skip when parsing the input ring file.
+This is useful in Zsh when the extended_history option is on.")
+
(defcustom comint-scroll-to-bottom-on-input nil
"Controls whether input to interpreter causes window to scroll.
If nil, then do not scroll. If t or `all', scroll all windows showing buffer.
@@ -351,6 +362,7 @@ This variable is buffer-local."
;; Some implementations of passwd use "Password (again)" as the 2nd prompt.
;; Something called "perforce" uses "Enter password:".
;; OpenVPN prints a prompt like: "Enter Auth Password:".
+;; OpenBSD doas prints "doas (user@host) password:".
;; See ert test `comint-test-password-regexp'.
(defcustom comint-password-prompt-regexp
(concat
@@ -359,7 +371,7 @@ This variable is buffer-local."
'("Enter" "enter" "Enter same" "enter same" "Enter the" "enter the"
"Enter Auth" "enter auth" "Old" "old" "New" "new" "'s" "login"
"Kerberos" "CVS" "UNIX" " SMB" "LDAP" "PEM" "SUDO"
- "[sudo]" "Repeat" "Bad" "Retype")
+ "[sudo]" "doas" "Repeat" "Bad" "Retype")
t)
;; Allow for user name to precede password equivalent (Bug#31075).
" +.*\\)"
@@ -599,6 +611,7 @@ The command \\[comint-accumulate] sets this.")
(put 'comint-replace-by-expanded-history 'menu-enable 'comint-input-autoexpand)
(put 'comint-input-ring 'permanent-local t)
+(put 'comint-input-ring-file-name 'permanent-local t)
(put 'comint-input-ring-index 'permanent-local t)
(put 'comint-save-input-ring-index 'permanent-local t)
(put 'comint-input-autoexpand 'permanent-local t)
@@ -731,7 +744,7 @@ contents are sent to the process as its initial input.
If PROGRAM is a string, any more args are arguments to PROGRAM.
Return the (possibly newly created) process buffer."
- (or (fboundp 'start-file-process)
+ (or (fboundp 'make-process)
(error "Multi-processing is not supported for this system"))
(setq buffer (get-buffer-create (or buffer (concat "*" name "*"))))
;; If no process, or nuked process, crank up a new one and put buffer in
@@ -809,18 +822,10 @@ series of processes in the same Comint buffer. The hook
(goto-char (point-max))
(set-marker (process-mark proc) (point))
;; Feed it the startfile.
- (cond (startfile
- ;;This is guaranteed to wait long enough
- ;;but has bad results if the comint does not prompt at all
- ;; (while (= size (buffer-size))
- ;; (sleep-for 1))
- ;;I hope 1 second is enough!
- (sleep-for 1)
- (goto-char (point-max))
- (insert-file-contents startfile)
- (setq startfile (buffer-substring (point) (point-max)))
- (delete-region (point) (point-max))
- (comint-send-string proc startfile)))
+ (when startfile
+ (comint-send-string proc (with-temp-buffer
+ (insert-file-contents startfile)
+ (buffer-string))))
(run-hooks 'comint-exec-hook)
buffer)))
@@ -987,8 +992,20 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
(setq end (match-beginning 0)))
(setq start
(if (re-search-backward ring-separator nil t)
- (match-end 0)
- (point-min)))
+ (progn
+ (when (and comint-input-ring-file-prefix
+ (looking-at
+ comint-input-ring-file-prefix))
+ ;; Skip zsh extended_history stamps
+ (goto-char (match-end 0)))
+ (match-end 0))
+ (progn
+ (goto-char (point-min))
+ (when (and comint-input-ring-file-prefix
+ (looking-at
+ comint-input-ring-file-prefix))
+ (goto-char (match-end 0)))
+ (point))))
(setq history (buffer-substring start end))
(goto-char start)
(when (and (not (string-match history-ignore history))
@@ -1758,7 +1775,7 @@ Argument 0 is the command name."
((>= mth 0) (1- (- count mth)))
(t (1- (- mth))))))
(mapconcat
- (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " "))))
+ (lambda (a) a) (nthcdr n (nreverse (nthcdr m args))) " "))))
;;
;; Input processing stuff
@@ -1881,9 +1898,10 @@ Similarly for Soar, Scheme, etc."
(end (if no-newline (point) (1- (point)))))
(with-silent-modifications
(when (> end beg)
- (add-text-properties beg end
- '(front-sticky t
- font-lock-face comint-highlight-input))
+ (when comint-highlight-input
+ (add-text-properties beg end
+ '( font-lock-face comint-highlight-input
+ front-sticky t )))
(unless comint-use-prompt-regexp
;; Give old user input a field property of `input', to
;; distinguish it from both process output and unsent
@@ -2350,6 +2368,7 @@ a buffer local variable."
;; For compatibility.
(defun comint-read-noecho (prompt &optional _ignore)
+ (declare (obsolete read-passwd "28.1"))
(read-passwd prompt))
;; These three functions are for entering text you don't want echoed or
@@ -2398,11 +2417,13 @@ Security bug: your string can still be temporarily recovered with
(defun comint-watch-for-password-prompt (string)
"Prompt in the minibuffer for password and send without echoing.
Looks for a match to `comint-password-prompt-regexp' in order
-to detect the need to (prompt and) send a password.
+to detect the need to (prompt and) send a password. Ignores any
+carriage returns (\\r) in STRING.
This function could be in the list `comint-output-filter-functions'."
(when (let ((case-fold-search t))
- (string-match comint-password-prompt-regexp string))
+ (string-match comint-password-prompt-regexp
+ (replace-regexp-in-string "\r" "" string)))
(when (string-match "^[ \n\r\t\v\f\b\a]+" string)
(setq string (replace-match "" t t string)))
(let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth)))
@@ -3124,7 +3145,7 @@ See `comint-word'."
"\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
"\\|{\\(?1:[^{}]+\\)}\\)"
(when (memq system-type '(ms-dos windows-nt))
- "\\|%\\(?1:[^\\\\/]*\\)%")
+ "\\|%\\(?1:[^\\/]*\\)%")
(when comint-file-name-quote-list
"\\|\\\\\\(.\\)")))
(qupos nil)
@@ -3425,7 +3446,7 @@ the completions."
(eq (window-buffer (posn-window (event-start first)))
(get-buffer "*Completions*"))
(memq (key-binding key)
- '(mouse-choose-completion choose-completion))))
+ '(choose-completion))))
;; If the user does choose-completion with the mouse,
;; execute the command, then delete the completion window.
(progn
@@ -3641,7 +3662,7 @@ and does not normally need to be invoked by the end user or programmer."
(setq-local comint-redirect-previous-input-string "")
(setq mode-line-process
- (if mode-line-process
+ (if (and mode-line-process (stringp (elt mode-line-process 0)))
(list (concat (elt mode-line-process 0) " Redirection"))
(list ":%s Redirection")))))
diff --git a/lisp/completion.el b/lisp/completion.el
index b2864746fc7..8a4c1676145 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -399,13 +399,6 @@ Used to decide whether to save completions.")
:up)
(t :neither))))))
-;; Tests -
-;; (cmpl-string-case-type "123ABCDEF456") --> :up
-;; (cmpl-string-case-type "123abcdef456") --> :down
-;; (cmpl-string-case-type "123aBcDeF456") --> :mixed
-;; (cmpl-string-case-type "123456") --> :neither
-;; (cmpl-string-case-type "Abcde123") --> :capitalized
-
(defun cmpl-coerce-string-case (string case-type)
(cond ((eq case-type :down) (downcase string))
((eq case-type :up) (upcase string))
@@ -424,12 +417,6 @@ Used to decide whether to save completions.")
;; as is
string-to-coerce))))
-;; Tests -
-;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456
-;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456
-;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456
-;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456
-
(defun cmpl-hours-since-origin ()
(floor (time-convert nil 'integer) 3600))
@@ -1226,45 +1213,6 @@ String must be longer than `completion-prefix-min-length'."
(set cmpl-db-prefix-symbol nil)))))
(error "Unknown completion `%s'" completion-string))))
-;; Tests --
-;; - Add and Find -
-;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
-;; (find-exact-completion "banana") --> ("banana" 0 nil 0)
-;; (find-exact-completion "bana") --> nil
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (add-completion-to-head "banish") --> ("banish" 0 nil 0)
-;; (find-exact-completion "banish") --> ("banish" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (add-completion-to-head "banana") --> ("banana" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
-;;
-;; - Deleting -
-;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
-;; (delete-completion "banner")
-;; (find-exact-completion "banner") --> nil
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
-;; (add-completion-to-head "banner") --> ("banner" 0 nil 0)
-;; (delete-completion "banana")
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...))
-;; (delete-completion "banner")
-;; (delete-completion "banish")
-;; (find-cmpl-prefix-entry "ban") --> nil
-;; (delete-completion "banner") --> error
-;;
-;; - Tail -
-;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...))
-;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...))
-;;
-
;;---------------------------------------------------------------------------
;; Database Update :: Interface level routines
@@ -1276,11 +1224,7 @@ String must be longer than `completion-prefix-min-length'."
(defun interactive-completion-string-reader (prompt)
(let* ((default (symbol-under-or-before-point))
- (new-prompt
- (if default
- (format "%s (default %s): " prompt default)
- (format "%s: " prompt)))
- (read (completing-read new-prompt cmpl-obarray)))
+ (read (completing-read (format-prompt prompt default) cmpl-obarray)))
(if (zerop (length read)) (setq read (or default "")))
(list read)))
@@ -1365,29 +1309,6 @@ Completions added this way will automatically be saved if
(set-completion-num-uses entry 1)
(setq cmpl-completions-accepted-p t)))))))
-;; Tests --
-;; - Add and Find -
-;; (add-completion "banana" 5 10)
-;; (find-exact-completion "banana") --> ("banana" 5 10 0)
-;; (add-completion "banana" 6)
-;; (find-exact-completion "banana") --> ("banana" 6 10 0)
-;; (add-completion "banish")
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...))
-;;
-;; - Accepting -
-;; (setq completion-to-accept "banana")
-;; (accept-completion)
-;; (find-exact-completion "banana") --> ("banana" 7 10)
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...))
-;; (setq completion-to-accept "banish")
-;; (add-completion "banner")
-;; (car (find-cmpl-prefix-entry "ban"))
-;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...))
-;;
-;; - Deleting -
-;; (kill-completion "banish")
-;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...))
-
;;---------------------------------------------------------------------------
;; Searching the database
@@ -1509,46 +1430,6 @@ If there are no more entries, try cdabbrev and then return only a string."
;; Completely unsuccessful, return nil
))
-;; Tests --
-;; - Add and Find -
-;; (add-completion "banana")
-;; (completion-search-reset "ban")
-;; (completion-search-next 0) --> "banana"
-;;
-;; - Discrimination -
-;; (add-completion "cumberland")
-;; (add-completion "cumberbund")
-;; cumbering
-;; (completion-search-reset "cumb")
-;; (completion-search-peek t) --> "cumberbund"
-;; (completion-search-next 0) --> "cumberbund"
-;; (completion-search-peek t) --> "cumberland"
-;; (completion-search-next 1) --> "cumberland"
-;; (completion-search-peek nil) --> nil
-;; (completion-search-next 2) --> "cumbering" {cdabbrev}
-;; (completion-search-next 3) --> nil or "cumming"{depends on context}
-;; (completion-search-next 1) --> "cumberland"
-;; (completion-search-peek t) --> "cumbering" {cdabbrev}
-;;
-;; - Accepting -
-;; (completion-search-next 1) --> "cumberland"
-;; (setq completion-to-accept "cumberland")
-;; (completion-search-reset "foo")
-;; (completion-search-reset "cum")
-;; (completion-search-next 0) --> "cumberland"
-;;
-;; - Deleting -
-;; (kill-completion "cumberland")
-;; cummings
-;; (completion-search-reset "cum")
-;; (completion-search-next 0) --> "cumberbund"
-;; (completion-search-next 1) --> "cummings"
-;;
-;; - Ignoring Capitalization -
-;; (completion-search-reset "CuMb")
-;; (completion-search-next 0) --> "cumberbund"
-
-
;;-----------------------------------------------
;; COMPLETE
@@ -1737,12 +1618,6 @@ Prefix args ::
"\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*"
"A regexp that searches for Lisp definition form.")
-;; Tests -
-;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8
-;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9
-;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10
-;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9
-
;; Parses all the definition names from a Lisp mode buffer and adds them to
;; the completion database.
(defun add-completions-from-lisp-buffer ()
@@ -2166,7 +2041,7 @@ Patched to remove the most recent completion."
;; All common separators (eg. space "(" ")" """) characters go through a
;; function to add new words to the list of words to complete from.
-;; If the character before this was an alpha-numeric then this adds the
+;; If the character before this was an alphanumeric then this adds the
;; symbol before point to the completion list (using ADD-COMPLETION).
(defvar completion-separator-chars
diff --git a/lisp/composite.el b/lisp/composite.el
index 77c5cd87b88..0a8dcb875c9 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -660,7 +660,7 @@ All non-spacing characters have this function in
;; align it at the center of the glyph of the
;; enclosing mark hoping that the enclosing mark
;; is big enough. We also have to adjust the
- ;; x-offset and width of the mark ifself properly
+ ;; x-offset and width of the mark itself properly
;; depending on how the glyph is designed.
;; (non-spacing or not). For instance, when we
@@ -747,7 +747,18 @@ All non-spacing characters have this function in
unicode-category-table))
;; for dotted-circle
(aset composition-function-table #x25CC
- `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle])))
+ `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle]))
+ ;; For prettier display of fractions
+ (set-char-table-range
+ composition-function-table
+ #x2044
+ ;; We use font-shape-gstring so that if the font doesn't support
+ ;; fractional display, the characters are shown separately, not as
+ ;; a composed cluster.
+ (list (vector (purecopy "[1-9][0-9][0-9]\u2044[0-9]+")
+ 3 'font-shape-gstring)
+ (vector (purecopy "[1-9][0-9]\u2044[0-9]+") 2 'font-shape-gstring)
+ (vector (purecopy "[1-9]\u2044[0-9]+") 1 'font-shape-gstring))))
(defun compose-gstring-for-terminal (gstring _direction)
"Compose glyph-string GSTRING for terminal display.
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index e2fd7febd2f..9003b7fc1b5 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -51,6 +51,25 @@ ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
(defalias sym e))))
'(defcustom defface defgroup)))
+(defun custom--get-def (expr)
+ (if (not (memq (car-safe expr)
+ '( define-minor-mode define-globalized-minor-mode)))
+ expr
+ ;; For define-minor-mode, we don't want to evaluate the whole
+ ;; expression, because it tends to define functions which aren't
+ ;; usable (because they call other functions that were skipped).
+ ;; Concretely it gave us an error
+ ;; "void-function bug-reference--run-auto-setup"
+ ;; when subsequently loading `cus-load.el'.
+ (let ((es (list (macroexpand-all expr)))
+ defs)
+ (while es
+ (let ((e (pop es)))
+ (pcase e
+ (`(progn . ,exps) (setq es (append exps es)))
+ (`(custom-declare-variable . ,_) (push e defs)))))
+ (macroexp-progn (nreverse defs)))))
+
(defun custom-make-dependencies ()
"Batch function to extract custom dependencies from .el files.
Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
@@ -70,7 +89,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(directory-files subdir nil
"\\`[^=.].*\\.el\\'"))))
(progress (make-progress-reporter
- (byte-compile-info-string "Scanning files for custom")
+ (byte-compile-info "Scanning files for custom")
0 (length files) nil 10)))
(with-temp-buffer
(dolist (elem files)
@@ -102,12 +121,16 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
"^(def\\(custom\\|face\\|group\\|ine\\(?:-globalized\\)?-minor-mode\\)" nil t)
(beginning-of-line)
(let ((type (match-string 1))
- (expr (read (current-buffer))))
+ (expr (custom--get-def (read (current-buffer)))))
(condition-case nil
- (let ((custom-dont-initialize t))
+ (let ((custom-dont-initialize t)
+ (sym (nth 1 expr)))
+ (put (if (eq (car-safe sym) 'quote)
+ (cadr sym)
+ sym)
+ 'custom-where name)
;; Eval to get the 'custom-group, -tag,
;; -version, group-documentation etc properties.
- (put (nth 1 expr) 'custom-where name)
(eval expr))
;; Eval failed for some reason. Eg maybe the
;; defcustom uses something defined earlier
@@ -127,8 +150,8 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
type)))))))))))
(error nil)))))))
(progress-reporter-done progress))
- (byte-compile-info-message "Generating %s..."
- generated-custom-dependencies-file)
+ (byte-compile-info
+ (format "Generating %s..." generated-custom-dependencies-file) t)
(set-buffer (find-file-noselect generated-custom-dependencies-file))
(setq buffer-undo-list t)
(erase-buffer)
@@ -148,7 +171,8 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(when found
(push (cons (symbol-name symbol)
(with-output-to-string
- (prin1 (sort found 'string<)))) alist))))))
+ (prin1 (sort found #'string<))))
+ alist))))))
(dolist (e (sort alist (lambda (e1 e2) (string< (car e1) (car e2)))))
(insert "(put '" (car e) " 'custom-loads '" (cdr e) ")\n")))
(insert "\
@@ -217,8 +241,8 @@ elements the files that have variables or faces that contain that
version. These files should be loaded before showing the customization
buffer that `customize-changed-options' generates.\")\n\n"))
(save-buffer)
- (byte-compile-info-message "Generating %s...done"
- generated-custom-dependencies-file))
+ (byte-compile-info
+ (format "Generating %s...done" generated-custom-dependencies-file) t))
(provide 'cus-dep)
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 490d9055ecf..d1077d367d5 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -408,10 +408,6 @@ Use group `text' for this instead. This group is deprecated."
"Input from the menus."
:group 'environment)
-(defgroup dnd nil
- "Handling data from drag and drop."
- :group 'environment)
-
(defgroup auto-save nil
"Preventing accidental loss of data."
:group 'files)
@@ -485,14 +481,20 @@ Return a list suitable for use in `interactive'."
(default (and (symbolp v) (custom-variable-p v) (symbol-name v)))
(enable-recursive-minibuffers t)
val)
- (setq val (completing-read
- (if default (format "Customize variable (default %s): " default)
- "Customize variable: ")
- obarray 'custom-variable-p t nil nil default))
+ (setq val (completing-read (format-prompt "Customize variable" default)
+ obarray 'custom-variable-p t nil nil default))
(list (if (equal val "")
(if (symbolp v) v nil)
(intern val)))))
+(defvar custom-actioned-widget nil
+ "Widget for which to show the menu of available actions.
+
+When showing a menu for a custom-variable, custom-face or custom-group widget,
+the respective custom-*-action functions bind this variable to that widget, and
+the respective custom-*-menu menus use the binding in their :enable and
+:selected forms.")
+
(defun custom-menu-filter (menu widget)
"Convert MENU to the form used by `widget-choose'.
MENU should be in the same format as `custom-variable-menu'.
@@ -561,7 +563,7 @@ value unless you are sure you know what it does."
(unless no-suffix
(goto-char (point-max))
(insert "..."))
- (buffer-string)))))
+ (propertize (buffer-string) 'custom-data symbol)))))
(defcustom custom-unlispify-tag-names t
"Display tag names as words instead of symbols if non-nil."
@@ -728,48 +730,86 @@ groups after non-groups, if nil do not order groups at all."
;; `custom-buffer-create-internal' if `custom-buffer-verbose-help' is non-nil.
(defvar custom-commands
- '((" Apply " Custom-set t
- "Apply settings (for the current session only)."
- "index"
- "Apply")
- (" Apply and Save " Custom-save
- (or custom-file user-init-file)
- "Apply settings and save for future sessions."
- "save"
- "Save")
+ '((" Apply " Custom-set t "Apply settings (for the current session only)."
+ "index" "Apply" (modified))
+ (" Apply and Save " Custom-save (or custom-file user-init-file)
+ "Apply settings and save for future sessions." "save" "Save"
+ (modified set changed rogue))
(" Undo Edits " Custom-reset-current t
"Restore customization buffer to reflect existing settings."
- "refresh"
- "Undo")
+ "refresh" "Undo" (modified))
(" Reset Customizations " Custom-reset-saved t
- "Undo any settings applied only for the current session."
- "undo"
- "Reset")
+ "Undo any settings applied only for the current session." "undo" "Reset"
+ (modified set changed rogue))
(" Erase Customizations " Custom-reset-standard
(or custom-file user-init-file)
- "Un-customize settings in this and future sessions."
- "delete"
- "Uncustomize")
- (" Help for Customize " Custom-help t
- "Get help for using Customize."
- "help"
- "Help")
- (" Exit " Custom-buffer-done t "Exit Customize." "exit" "Exit")))
+ "Un-customize settings in this and future sessions." "delete" "Uncustomize"
+ (modified set changed rogue saved))
+ (" Help for Customize " Custom-help t "Get help for using Customize."
+ "help" "Help" t)
+ (" Exit " Custom-buffer-done t "Exit Customize." "exit" "Exit" t))
+ "Alist of specifications for Customize menu items, tool bar icons and buttons.
+Each member has the format (TAG COMMAND VISIBLE HELP ICON LABEL ENABLE).
+TAG is a string, used as the :tag property of a widget.
+COMMAND is the command that the item or button runs.
+VISIBLE should be a form, suitable to pass as the :visible property for menu
+or tool bar items.
+HELP should be a string that can be used as the help echo property for tooltips
+and the like.
+ICON is a string that names the image to use for the tool bar item, like in the
+first argument of `tool-bar-local-item'.
+LABEL should be a string, used as the name of the menu items.
+ENABLE should be a list of custom states or t. When ENABLE is t, the item is
+always enabled. Otherwise, it is enabled only if at least one option displayed
+in the Custom buffer is in a state present in ENABLE.")
+
+(defvar-local custom-command-buttons nil
+ "A list that holds the buttons that act on all settings in a Custom buffer.
+`custom-buffer-create-internal' adds the buttons to this list.
+Changes in the state of the custom options should notify the buttons via the
+:notify property, so buttons can be enabled/disabled correctly at all times.")
(defun Custom-help ()
"Read the node on Easy Customization in the Emacs manual."
(interactive)
(info "(emacs)Easy Customization"))
-(defvar custom-reset-menu
- '(("Undo Edits in Customization Buffer" . Custom-reset-current)
- ("Revert This Session's Customizations" . Custom-reset-saved)
- ("Erase Customizations" . Custom-reset-standard))
- "Alist of actions for the `Reset' button.
+(defvar custom-reset-menu nil
+ "If non-nil, an alist of actions for the `Reset' button.
+
+This variable is kept for backward compatibility reasons, please use
+`custom-reset-extended-menu' instead.
+
The key is a string containing the name of the action, the value is a
Lisp function taking the widget as an element which will be called
when the action is chosen.")
+(defvar custom-reset-extended-menu
+ (let ((map (make-sparse-keymap)))
+ (define-key-after map [Custom-reset-current]
+ '(menu-item "Undo Edits in Customization Buffer" Custom-reset-current
+ :enable (seq-some (lambda (option)
+ (eq (widget-get option :custom-state)
+ 'modified))
+ custom-options)))
+ (define-key-after map [Custom-reset-saved]
+ '(menu-item "Revert This Session's Customizations" Custom-reset-saved
+ :enable (seq-some (lambda (option)
+ (memq (widget-get option :custom-state)
+ '(modified set changed rogue)))
+ custom-options)))
+ (when (or custom-file user-init-file)
+ (define-key-after map [Custom-reset-standard]
+ '(menu-item "Erase Customizations" Custom-reset-standard
+ :enable (seq-some
+ (lambda (option)
+ (memq (widget-get option :custom-state)
+ '(modified set changed rogue saved)))
+ custom-options))))
+ map)
+ "A menu for the \"Revert...\" button.
+Used in `custom-reset' to show a menu to the user.")
+
(defvar custom-options nil
"Customization widgets in the current buffer.")
@@ -801,22 +841,26 @@ has been executed, nil otherwise."
If a setting was edited and set before, this saves it. If a
setting was merely edited before, this sets it then saves it."
(interactive)
- (when (custom-command-apply
- (lambda (child)
- (when (memq (widget-get child :custom-state)
- '(modified set changed rogue))
- (widget-apply child :custom-mark-to-save)))
- "Save all settings in this buffer? " t)
- ;; Save changes to buffer and redraw.
- (custom-save-all)
- (dolist (child custom-options)
- (widget-apply child :custom-state-set-and-redraw))))
+ (let (edited-widgets)
+ (when (custom-command-apply
+ (lambda (child)
+ (when (memq (widget-get child :custom-state)
+ '(modified set changed rogue))
+ (push child edited-widgets)
+ (widget-apply child :custom-mark-to-save)))
+ "Save all settings in this buffer? " t)
+ ;; Save changes to buffer.
+ (custom-save-all)
+ ;; Redraw and recalculate the state when necessary.
+ (dolist (widget edited-widgets)
+ (widget-apply widget :custom-state-set-and-redraw)))))
(defun custom-reset (_widget &optional event)
"Select item from reset menu."
(let* ((completion-ignore-case t)
(answer (widget-choose "Reset settings"
- custom-reset-menu
+ (or custom-reset-menu
+ custom-reset-extended-menu)
event)))
(if answer
(funcall answer))))
@@ -1081,9 +1125,7 @@ for the MODE to customize."
(if (and group (not current-prefix-arg))
major-mode
(intern
- (completing-read (if group
- (format "Mode (default %s): " major-mode)
- "Mode: ")
+ (completing-read (format-prompt "Mode" (and group major-mode))
obarray
'custom-group-of-mode
t nil nil (if group (symbol-name major-mode))))))))
@@ -1216,8 +1258,8 @@ that were added or redefined since that version."
(interactive
(list
(read-from-minibuffer
- (format "Customize options changed, since version (default %s): "
- customize-changed-options-previous-release))))
+ (format-prompt "Customize options changed, since version"
+ customize-changed-options-previous-release))))
(if (equal since-version "")
(setq since-version nil)
(unless (condition-case nil
@@ -1552,7 +1594,10 @@ that option.
DESCRIPTION is unused."
(pop-to-buffer-same-window
(custom-get-fresh-buffer (or name "*Customization*")))
- (custom-buffer-create-internal options))
+ (custom-buffer-create-internal options)
+ ;; Notify the command buttons, to correctly enable/disable them.
+ (dolist (btn custom-command-buttons)
+ (widget-apply btn :notify)))
;;;###autoload
(defun custom-buffer-create-other-window (options &optional name _description)
@@ -1669,11 +1714,24 @@ or a regular expression.")
(if custom-buffer-verbose-help
(widget-insert "
Operate on all settings in this buffer:\n"))
- (let ((button (lambda (tag action active help _icon _label)
+ (let ((button (lambda (tag action visible help _icon _label active)
(widget-insert " ")
- (if (eval active)
- (widget-create 'push-button :tag tag
- :help-echo help :action action))))
+ (if (eval visible)
+ (push (widget-create
+ 'push-button :tag tag
+ :help-echo help :action action
+ :notify
+ (lambda (widget)
+ (when (listp active)
+ (if (seq-some
+ (lambda (widget)
+ (memq
+ (widget-get widget :custom-state)
+ active))
+ custom-options)
+ (widget-apply widget :activate)
+ (widget-apply widget :deactivate)))))
+ custom-command-buttons))))
(commands custom-commands))
(if custom-reset-button-menu
(progn
@@ -2212,7 +2270,11 @@ and `face'."
(let ((state (widget-get widget :custom-state)))
(unless (eq state 'modified)
(unless (memq state '(nil unknown hidden))
- (widget-put widget :custom-state 'modified))
+ (widget-put widget :custom-state 'modified)
+ ;; Tell our buttons and the tool bar that we changed the widget's state.
+ (force-mode-line-update)
+ (dolist (btn custom-command-buttons)
+ (widget-apply btn :notify)))
;; Update the status text (usually from "STANDARD" to "EDITED
;; bla bla" in the buffer after the command has run. Otherwise
;; commands like `M-u' (that work on a region in the buffer)
@@ -2251,7 +2313,10 @@ and `face'."
(custom-group-state-update widget)))
(t
(setq widget nil)))))
- (widget-setup))
+ (widget-setup)
+ (force-mode-line-update)
+ (dolist (btn custom-command-buttons)
+ (widget-apply btn :notify)))
(defun custom-show (widget value)
"Non-nil if WIDGET should be shown with VALUE by default."
@@ -2682,7 +2747,7 @@ try matching its doc string against `custom-guess-doc-alist'."
:sample-face (if obsolete
'custom-variable-obsolete
'custom-variable-tag)
- tag)
+ :tag tag)
buttons)
(push (widget-create-child-and-convert
widget type
@@ -2786,7 +2851,9 @@ Possible return values are `standard', `saved', `set', `themed',
(and (equal value (eval (car tmp)))
(equal comment temp))
(error nil))
- 'set
+ (if (equal value (eval (car (get symbol 'standard-value))))
+ 'standard
+ 'set)
'changed))
((progn (setq tmp (get symbol 'theme-value))
(setq temp (get symbol 'saved-variable-comment))
@@ -2856,53 +2923,93 @@ otherwise."
(defun custom-variable-standard-value (widget)
(get (widget-value widget) 'standard-value))
-(defvar custom-variable-menu
- `(("Set for Current Session" custom-variable-set
- (lambda (widget)
- (eq (widget-get widget :custom-state) 'modified)))
- ;; Note that in all the backquoted code in this file, we test
- ;; init-file-user rather than user-init-file. This is in case
- ;; cus-edit is loaded by something in site-start.el, because
- ;; user-init-file is not set at that stage.
- ;; https://lists.gnu.org/r/emacs-devel/2007-10/msg00310.html
- ,@(when (or custom-file init-file-user)
- '(("Save for Future Sessions" custom-variable-save
- (lambda (widget)
- (memq (widget-get widget :custom-state)
- '(modified set changed rogue))))))
- ("Undo Edits" custom-redraw
- (lambda (widget)
- (and (default-boundp (widget-value widget))
- (memq (widget-get widget :custom-state) '(modified changed)))))
- ("Revert This Session's Customization" custom-variable-reset-saved
- (lambda (widget)
- (memq (widget-get widget :custom-state)
- '(modified set changed rogue))))
- ,@(when (or custom-file init-file-user)
- '(("Erase Customization" custom-variable-reset-standard
- (lambda (widget)
- (and (get (widget-value widget) 'standard-value)
- (memq (widget-get widget :custom-state)
- '(modified set changed saved rogue)))))))
- ("Set to Backup Value" custom-variable-reset-backup
- (lambda (widget)
- (get (widget-value widget) 'backup-value)))
- ("---" ignore ignore)
- ("Add Comment" custom-comment-show custom-comment-invisible-p)
- ("---" ignore ignore)
- ("Show Current Value" custom-variable-edit
- (lambda (widget)
- (eq (widget-get widget :custom-form) 'lisp)))
- ("Show Saved Lisp Expression" custom-variable-edit-lisp
- (lambda (widget)
- (eq (widget-get widget :custom-form) 'edit))))
- "Alist of actions for the `custom-variable' widget.
+(defun custom-variable-current-value (widget)
+ "Return the current value of the variable edited by WIDGET.
+
+WIDGET should be a custom-variable widget."
+ (let* ((symbol (widget-value widget))
+ (get (or (get symbol 'custom-get) 'default-value))
+ (type (custom-variable-type symbol))
+ (conv (widget-convert type)))
+ (if (default-boundp symbol)
+ (funcall get symbol)
+ (widget-get conv :value))))
+
+(defvar custom-variable-menu nil
+ "If non-nil, an alist of actions for the `custom-variable' widget.
+
+This variable is kept for backward compatibility reasons, please use
+`custom-variable-extended-menu' instead.
+
Each entry has the form (NAME ACTION FILTER) where NAME is the name of
the menu entry, ACTION is the function to call on the widget when the
menu is selected, and FILTER is a predicate which takes a `custom-variable'
widget as an argument, and returns non-nil if ACTION is valid on that
widget. If FILTER is nil, ACTION is always valid.")
+(defvar custom-variable-extended-menu
+ ;; No need to give the keymap a prompt, `widget-choose' takes care of it.
+ (let ((map (make-sparse-keymap)))
+ (define-key-after map [custom-variable-set]
+ '(menu-item "Set for Current Session" custom-variable-set
+ :enable (eq (widget-get custom-actioned-widget :custom-state)
+ 'modified)))
+ ;; Conditionally add items that depend on having loaded the custom-file,
+ ;; rather than giving it a :visible form, because we used to conditionally
+ ;; add this item when using simplified menus.
+ ;; Note that we test init-file-user rather than user-init-file. This is
+ ;; in case cus-edit is loaded by something in site-start.el, because
+ ;; user-init-file is not set at that stage.
+ ;; https://lists.gnu.org/r/emacs-devel/2007-10/msg00310.html
+ (when (or custom-file init-file-user)
+ (define-key-after map [custom-variable-save]
+ '(menu-item "Save for Future Sessions" custom-variable-save
+ :enable (memq
+ (widget-get custom-actioned-widget :custom-state)
+ '(modified set changed rogue)))))
+ (define-key-after map [custom-redraw]
+ '(menu-item "Undo Edits" custom-redraw
+ :enable (memq
+ (widget-get custom-actioned-widget :custom-state)
+ '(modified changed))))
+ (define-key-after map [custom-variable-reset-saved]
+ '(menu-item "Revert This Session's Customization"
+ custom-variable-reset-saved
+ :enable (memq
+ (widget-get custom-actioned-widget :custom-state)
+ '(modified set changed rogue))))
+ (when (or custom-file init-file-user)
+ (define-key-after map [custom-variable-reset-standard]
+ '(menu-item "Erase Customization" custom-variable-reset-standard
+ :enable (memq
+ (widget-get custom-actioned-widget :custom-state)
+ '(modified set changed saved rogue)))))
+ (define-key-after map [custom-variable-reset-backup]
+ '(menu-item "Set to Backup Value" custom-variable-reset-backup
+ :enable (get
+ (widget-value custom-actioned-widget)
+ 'backup-value)))
+ (define-key-after map [sep0]
+ '(menu-item "---"))
+ (define-key-after map [custom-comment-show]
+ '(menu-item "Add Comment" custom-comment-show
+ :enable (custom-comment-invisible-p custom-actioned-widget)))
+ (define-key-after map [sep1]
+ '(menu-item "---"))
+ (define-key-after map [custom-variable-edit]
+ '(menu-item "Show Current Value" custom-variable-edit
+ :button (:radio . (eq (widget-get custom-actioned-widget
+ :custom-form)
+ 'edit))))
+ (define-key-after map [custom-variable-edit-lisp]
+ '(menu-item "Show Saved Lisp Expression" custom-variable-edit-lisp
+ :button (:radio . (eq (widget-get custom-actioned-widget
+ :custom-form)
+ 'lisp))))
+ map)
+ "A menu for `custom-variable' widgets.
+Used in `custom-variable-action' to show a menu to the user.")
+
(defun custom-variable-action (widget &optional event)
"Show the menu for `custom-variable' WIDGET.
Optional EVENT is the location for the menu."
@@ -2912,12 +3019,17 @@ Optional EVENT is the location for the menu."
(custom-variable-state-set widget))
(custom-redraw-magic widget)
(let* ((completion-ignore-case t)
+ (custom-actioned-widget widget)
(answer (widget-choose (concat "Operation on "
- (custom-unlispify-tag-name
- (widget-get widget :value)))
- (custom-menu-filter custom-variable-menu
- widget)
- event)))
+ (custom-unlispify-tag-name
+ (widget-get widget :value)))
+ ;; Get rid of checks like this one if we ever
+ ;; remove the simplified menus.
+ (if custom-variable-menu
+ (custom-menu-filter custom-variable-menu
+ widget)
+ custom-variable-extended-menu)
+ event)))
(if answer
(funcall answer widget)))))
@@ -2953,10 +3065,12 @@ Optional EVENT is the location for the menu."
(setq comment nil)
;; Make the comment invisible by hand if it's empty
(custom-comment-hide comment-widget))
- (custom-variable-backup-value widget)
+ (setq val (widget-value child))
+ (unless (equal (eval val) (custom-variable-current-value widget))
+ (custom-variable-backup-value widget))
(custom-push-theme 'theme-value symbol 'user
- 'set (custom-quote (widget-value child)))
- (funcall set symbol (eval (setq val (widget-value child))))
+ 'set (custom-quote val))
+ (funcall set symbol (eval val))
(put symbol 'customized-value (list val))
(put symbol 'variable-comment comment)
(put symbol 'customized-variable-comment comment))
@@ -2965,10 +3079,12 @@ Optional EVENT is the location for the menu."
(setq comment nil)
;; Make the comment invisible by hand if it's empty
(custom-comment-hide comment-widget))
- (custom-variable-backup-value widget)
+ (setq val (widget-value child))
+ (unless (equal val (custom-variable-current-value widget))
+ (custom-variable-backup-value widget))
(custom-push-theme 'theme-value symbol 'user
- 'set (custom-quote (widget-value child)))
- (funcall set symbol (setq val (widget-value child)))
+ 'set (custom-quote val))
+ (funcall set symbol val)
(put symbol 'customized-value (list (custom-quote val)))
(put symbol 'variable-comment comment)
(put symbol 'customized-variable-comment comment)))
@@ -3037,17 +3153,23 @@ before this operation becomes the backup value."
(let* ((symbol (widget-value widget))
(saved-value (get symbol 'saved-value))
(comment (get symbol 'saved-variable-comment))
+ (old-value (custom-variable-current-value widget))
value)
- (custom-variable-backup-value widget)
(if (not (or saved-value comment))
- ;; If there is no saved value, remove the setting.
- (custom-push-theme 'theme-value symbol 'user 'reset)
+ (progn
+ (setq value (car (get symbol 'standard-value)))
+ ;; If there is no saved value, remove the setting.
+ (custom-push-theme 'theme-value symbol 'user 'reset)
+ ;; And reset this property too.
+ (put symbol 'variable-comment nil))
(setq value (car-safe saved-value))
(custom-push-theme 'theme-value symbol 'user 'set value)
(put symbol 'variable-comment comment))
+ (unless (equal (eval value) old-value)
+ (custom-variable-backup-value widget))
(ignore-errors
(funcall (or (get symbol 'custom-set) #'set-default) symbol
- (eval (or value (car (get symbol 'standard-value))))))
+ (eval value)))
(put symbol 'customized-value nil)
(put symbol 'customized-variable-comment nil)
(widget-put widget :custom-state 'unknown)
@@ -3060,7 +3182,9 @@ If `custom-reset-standard-variables-list' is nil, save, reset and
redraw the widget immediately."
(let* ((symbol (widget-value widget)))
(if (get symbol 'standard-value)
- (custom-variable-backup-value widget)
+ (unless (equal (custom-variable-current-value widget)
+ (eval (car (get symbol 'standard-value))))
+ (custom-variable-backup-value widget))
(user-error "No standard setting known for %S" symbol))
(put symbol 'variable-comment nil)
(put symbol 'customized-value nil)
@@ -3097,13 +3221,8 @@ becomes the backup value, so you can get it again."
(defun custom-variable-backup-value (widget)
"Back up the current value for WIDGET's variable.
The backup value is kept in the car of the `backup-value' property."
- (let* ((symbol (widget-value widget))
- (get (or (get symbol 'custom-get) 'default-value))
- (type (custom-variable-type symbol))
- (conv (widget-convert type))
- (value (if (default-boundp symbol)
- (funcall get symbol)
- (widget-get conv :value))))
+ (let ((symbol (widget-value widget))
+ (value (custom-variable-current-value widget)))
(put symbol 'backup-value (list value))))
(defun custom-variable-reset-backup (widget)
@@ -3169,6 +3288,7 @@ face attributes (as specified by a `default' defface entry)."
:convert-widget 'custom-face-edit-convert-widget
:args (mapcar (lambda (att)
(list 'group :inline t
+ :format "%v"
:sibling-args (widget-get (nth 1 att) :sibling-args)
(list 'const :format "" :value (nth 0 att))
(nth 1 att)))
@@ -3565,19 +3685,24 @@ the present value is saved to its :shown-value property instead."
(widget-put widget :buttons buttons))
;; Draw an ordinary `custom-face' widget
- (let ((opoint (point)))
- ;; Visibility indicator.
- (push (widget-create-child-and-convert
- widget 'custom-visibility
- :help-echo "Hide or show this face."
- :on "Hide" :off "Show"
- :on-glyph "down" :off-glyph "right"
- :action 'custom-toggle-hide-face
- (not hiddenp))
- buttons)
- ;; Face name (tag).
- (insert " " tag)
- (widget-specify-sample widget opoint (point)))
+ ;; Visibility indicator.
+ (push (widget-create-child-and-convert
+ widget 'custom-visibility
+ :help-echo "Hide or show this face."
+ :on "Hide" :off "Show"
+ :on-glyph "down" :off-glyph "right"
+ :action 'custom-toggle-hide-face
+ (not hiddenp))
+ buttons)
+ ;; Face name (tag).
+ (insert " ")
+ (push (widget-create-child-and-convert
+ widget 'face-link
+ :button-face 'link
+ :tag tag
+ :action (lambda (&rest _x)
+ (find-face-definition symbol)))
+ buttons)
(insert
(cond ((eq custom-buffer-style 'face) " ")
((string-match-p "face\\'" tag) ":")
@@ -3676,39 +3801,74 @@ the present value is saved to its :shown-value property instead."
(widget-put widget :children children)
(custom-face-state-set widget))))))
-(defvar custom-face-menu
- `(("Set for Current Session" custom-face-set)
- ,@(when (or custom-file init-file-user)
- '(("Save for Future Sessions" custom-face-save)))
- ("Undo Edits" custom-redraw
- (lambda (widget)
- (memq (widget-get widget :custom-state) '(modified changed))))
- ("Revert This Session's Customization" custom-face-reset-saved
- (lambda (widget)
- (memq (widget-get widget :custom-state) '(modified set changed))))
- ,@(when (or custom-file init-file-user)
- '(("Erase Customization" custom-face-reset-standard
- (lambda (widget)
- (get (widget-value widget) 'face-defface-spec)))))
- ("---" ignore ignore)
- ("Add Comment" custom-comment-show custom-comment-invisible-p)
- ("---" ignore ignore)
- ("For Current Display" custom-face-edit-selected
- (lambda (widget)
- (not (eq (widget-get widget :custom-form) 'selected))))
- ("For All Kinds of Displays" custom-face-edit-all
- (lambda (widget)
- (not (eq (widget-get widget :custom-form) 'all))))
- ("Show Lisp Expression" custom-face-edit-lisp
- (lambda (widget)
- (not (eq (widget-get widget :custom-form) 'lisp)))))
- "Alist of actions for the `custom-face' widget.
+(defun cus--face-link (widget _format)
+ (widget-create-child-and-convert
+ widget 'face-link
+ :button-face 'link
+ :tag "link"
+ :action (lambda (&rest _x)
+ (customize-face (widget-value widget)))))
+
+(defvar custom-face-menu nil
+ "If non-nil, an alist of actions for the `custom-face' widget.
+
+This variable is kept for backward compatibility reasons, please use
+`custom-face-extended-menu' instead.
+
Each entry has the form (NAME ACTION FILTER) where NAME is the name of
the menu entry, ACTION is the function to call on the widget when the
menu is selected, and FILTER is a predicate which takes a `custom-face'
widget as an argument, and returns non-nil if ACTION is valid on that
widget. If FILTER is nil, ACTION is always valid.")
+(defvar custom-face-extended-menu
+ (let ((map (make-sparse-keymap)))
+ (define-key-after map [custom-face-set]
+ '(menu-item "Set for Current Session" custom-face-set))
+ (when (or custom-file init-file-user)
+ (define-key-after map [custom-face-save]
+ '(menu-item "Save for Future Sessions" custom-face-save)))
+ (define-key-after map [custom-redraw]
+ '(menu-item "Undo Edits" custom-redraw
+ :enable (memq
+ (widget-get custom-actioned-widget :custom-state)
+ '(modified changed))))
+ (define-key-after map [custom-face-reset-saved]
+ '(menu-item "Revert This Session's Customization" custom-face-reset-saved
+ :enable (memq
+ (widget-get custom-actioned-widget :custom-state)
+ '(modified set changed))))
+ (when (or custom-file init-file-user)
+ (define-key-after map [custom-face-reset-standard]
+ '(menu-item "Erase Customization" custom-face-reset-standard
+ :enable (get (widget-value custom-actioned-widget)
+ 'face-defface-spec))))
+ (define-key-after map [sep0]
+ '(menu-item "---"))
+ (define-key-after map [custom-comment-show]
+ '(menu-item "Add Comment" custom-comment-show
+ :enable (custom-comment-invisible-p custom-actioned-widget)))
+ (define-key-after map [sep1]
+ '(menu-item "---"))
+ (define-key-after map [custom-face-edit-selected]
+ '(menu-item "For Current Display" custom-face-edit-selected
+ :button (:radio . (eq (widget-get custom-actioned-widget
+ :custom-form)
+ 'selected))))
+ (define-key-after map [custom-face-edit-all]
+ '(menu-item "For All Kinds of Displays" custom-face-edit-all
+ :button (:radio . (eq (widget-get custom-actioned-widget
+ :custom-form)
+ 'all))))
+ (define-key-after map [custom-face-edit-lisp]
+ '(menu-item "Show Lisp Expression" custom-face-edit-lisp
+ :button (:radio . (eq (widget-get custom-actioned-widget
+ :custom-form)
+ 'lisp))))
+ map)
+ "A menu for `custom-face' widgets.
+Used in `custom-face-action' to show a menu to the user.")
+
(defun custom-face-edit-selected (widget)
"Edit selected attributes of the value of WIDGET."
(widget-put widget :custom-state 'unknown)
@@ -3775,12 +3935,15 @@ Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
(custom-toggle-hide widget)
(let* ((completion-ignore-case t)
+ (custom-actioned-widget widget)
(symbol (widget-get widget :value))
(answer (widget-choose (concat "Operation on "
(custom-unlispify-tag-name symbol))
- (custom-menu-filter custom-face-menu
- widget)
- event)))
+ (if custom-face-menu
+ (custom-menu-filter custom-face-menu
+ widget)
+ custom-face-extended-menu)
+ event)))
(if answer
(funcall answer widget)))))
@@ -3825,7 +3988,22 @@ Optional EVENT is the location for the menu."
(defun custom-face-save (widget)
"Save the face edited by WIDGET."
- (custom-face-mark-to-save widget)
+ (let ((form (widget-get widget :custom-form)))
+ (if (memq form '(all lisp))
+ (custom-face-mark-to-save widget)
+ ;; The user is working on only a selected terminal type;
+ ;; make sure we save the entire spec to `custom-file'. (Bug #40866)
+ ;; If recreating a widget that may have been edited by the user, remember
+ ;; to always save the edited value into the :shown-value property, so
+ ;; we use that value for the recreated widget. (Bug#44331)
+ (widget-put widget :shown-value (custom-face-widget-to-spec widget))
+ (custom-face-edit-all widget)
+ (widget-put widget :shown-value nil) ; Reset it after we used it.
+ (custom-face-mark-to-save widget)
+ (if (eq form 'selected)
+ (custom-face-edit-selected widget)
+ ;; `form' is edit or mismatch; can't happen.
+ (widget-put widget :custom-form form))))
(custom-save-all)
(custom-face-state-set-and-redraw widget))
@@ -3905,7 +4083,7 @@ restoring it to the state of a face that has never been customized."
(define-widget 'face 'symbol
"A Lisp face name (with sample)."
- :format "%{%t%}: (%{sample%}) %v"
+ :format "%{%t%}: %f (%{sample%}) %v"
:tag "Face"
:value 'default
:sample-face-get 'widget-face-sample-face-get
@@ -3915,6 +4093,7 @@ restoring it to the state of a face that has never been customized."
obarray #'facep 'strict)
:prompt-match 'facep
:prompt-history 'widget-face-prompt-value-history
+ :format-handler 'cus--face-link
:validate (lambda (widget)
(unless (facep (widget-value widget))
(widget-put widget
@@ -4300,43 +4479,65 @@ This works for both graphical and text displays."
(insert "\n")
(custom-group--draw-horizontal-line)))))
-(defvar custom-group-menu
- `(("Set for Current Session" custom-group-set
- (lambda (widget)
- (eq (widget-get widget :custom-state) 'modified)))
- ,@(when (or custom-file init-file-user)
- '(("Save for Future Sessions" custom-group-save
- (lambda (widget)
- (memq (widget-get widget :custom-state) '(modified set))))))
- ("Undo Edits" custom-group-reset-current
- (lambda (widget)
- (memq (widget-get widget :custom-state) '(modified))))
- ("Revert This Session's Customizations" custom-group-reset-saved
- (lambda (widget)
- (memq (widget-get widget :custom-state) '(modified set))))
- ,@(when (or custom-file init-file-user)
- '(("Erase Customization" custom-group-reset-standard
- (lambda (widget)
- (memq (widget-get widget :custom-state) '(modified set saved)))))))
- "Alist of actions for the `custom-group' widget.
+(defvar custom-group-menu nil
+ "If non-nil, an alist of actions for the `custom-group' widget.
+
+This variable is kept for backward compatibility reasons, please use
+`custom-group-extended-menu' instead.
+
Each entry has the form (NAME ACTION FILTER) where NAME is the name of
the menu entry, ACTION is the function to call on the widget when the
menu is selected, and FILTER is a predicate which takes a `custom-group'
widget as an argument, and returns non-nil if ACTION is valid on that
widget. If FILTER is nil, ACTION is always valid.")
+(defvar custom-group-extended-menu
+ (let ((map (make-sparse-keymap)))
+ (define-key-after map [custom-group-set]
+ '(menu-item "Set for Current Session" custom-group-set
+ :enable (eq (widget-get custom-actioned-widget :custom-state)
+ 'modified)))
+ (when (or custom-file init-file-user)
+ (define-key-after map [custom-group-save]
+ '(menu-item "Save for Future Sessions" custom-group-save
+ :enable (memq
+ (widget-get custom-actioned-widget :custom-state)
+ '(modified set)))))
+ (define-key-after map [custom-group-reset-current]
+ '(menu-item "Undo Edits" custom-group-reset-current
+ :enable (eq (widget-get custom-actioned-widget :custom-state)
+ 'modified)))
+ (define-key-after map [custom-group-reset-saved]
+ '(menu-item "Revert This Session's Customizations"
+ custom-group-reset-saved
+ :enable (memq
+ (widget-get custom-actioned-widget :custom-state)
+ '(modified set))))
+ (when (or custom-file init-file-user)
+ (define-key-after map [custom-group-reset-standard]
+ '(menu-item "Erase Customization" custom-group-reset-standard
+ :enable (memq
+ (widget-get custom-actioned-widget :custom-state)
+ '(modified set saved)))))
+ map)
+ "A menu for `custom-group' widgets.
+Used in `custom-group-action' to show a menu to the user.")
+
(defun custom-group-action (widget &optional event)
"Show the menu for `custom-group' WIDGET.
Optional EVENT is the location for the menu."
(if (eq (widget-get widget :custom-state) 'hidden)
(custom-toggle-hide widget)
(let* ((completion-ignore-case t)
+ (custom-actioned-widget widget)
(answer (widget-choose (concat "Operation on "
(custom-unlispify-tag-name
(widget-get widget :value)))
- (custom-menu-filter custom-group-menu
- widget)
- event)))
+ (if custom-group-menu
+ (custom-menu-filter custom-group-menu
+ widget)
+ custom-group-extended-menu)
+ event)))
(if answer
(funcall answer widget)))))
@@ -4578,15 +4779,12 @@ This function does not save the buffer."
(setq pos (line-beginning-position))))
(goto-char pos)))))
-(defvar sort-fold-case) ; defined in sort.el
-
(defun custom-save-variables ()
"Save all customized variables in `custom-file'."
(save-excursion
(custom-save-delete 'custom-set-variables)
(let ((standard-output (current-buffer))
- (saved-list (make-list 1 0))
- sort-fold-case)
+ (saved-list (make-list 1 0)))
;; First create a sorted list of saved variables.
(mapatoms
(lambda (symbol)
@@ -4668,8 +4866,7 @@ This function does not save the buffer."
(custom-save-delete 'custom-reset-faces)
(custom-save-delete 'custom-set-faces)
(let ((standard-output (current-buffer))
- (saved-list (make-list 1 0))
- sort-fold-case)
+ (saved-list (make-list 1 0)))
;; First create a sorted list of saved faces.
(mapatoms
(lambda (symbol)
@@ -4810,9 +5007,19 @@ The format is suitable for use with `easy-menu-define'."
(mapcar (lambda (arg)
(let ((tag (nth 0 arg))
(command (nth 1 arg))
- (active (nth 2 arg))
- (help (nth 3 arg)))
- (vector tag command :active (eval active) :help help)))
+ (visible (nth 2 arg))
+ (help (nth 3 arg))
+ (active (nth 6 arg)))
+ (vector tag command :visible (eval visible)
+ :active
+ `(or (eq t ',active)
+ (seq-some ,(lambda (widget)
+ (memq
+ (widget-get widget
+ :custom-state)
+ active))
+ custom-options))
+ :help help)))
custom-commands)))
(defvar tool-bar-map)
@@ -4831,7 +5038,10 @@ The format is suitable for use with `easy-menu-define'."
(error "You can't edit this part of the Custom buffer"))
(defun Custom-newline (pos &optional event)
- "Invoke button at POS, or refuse to allow editing of Custom buffer."
+ "Invoke button at POS, or refuse to allow editing of Custom buffer.
+
+To see what function the widget will call, use the
+`widget-describe' command."
(interactive "@d")
(let ((button (get-char-property pos 'button)))
;; If there is no button at point, then use the one at the start
@@ -4855,8 +5065,6 @@ If several parents are listed, go to the first of them."
(parent (downcase (widget-get button :tag))))
(customize-group parent)))))
-(define-obsolete-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1")
-
(defcustom Custom-mode-hook nil
"Hook called when entering Custom mode."
:type 'hook
@@ -4927,8 +5135,6 @@ if that value is non-nil."
(put 'Custom-mode 'mode-class 'special)
-(define-obsolete-function-alias 'custom-mode 'Custom-mode "23.1")
-
;;; The End.
(provide 'cus-edit)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index ed4cf046fcf..cc766aa4509 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -166,9 +166,11 @@
:help-echo "Control box around text."
(const :tag "Off" nil)
(list :tag "Box"
- :value (:line-width 2 :color "grey75" :style released-button)
- (const :format "" :value :line-width)
- (integer :tag "Width")
+ :value (:line-width (2 . 2) :color "grey75" :style released-button)
+ (const :format "" :value :line-width)
+ (cons :tag "Width" :extra-offset 2
+ (integer :tag "Vertical")
+ (integer :tag "Horizontal"))
(const :format "" :value :color)
(choice :tag "Color" (const :tag "*" nil) color)
(const :format "" :value :style)
@@ -181,15 +183,19 @@
(and real-value
(let ((lwidth
(or (and (consp real-value)
- (plist-get real-value :line-width))
+ (if (listp (cdr real-value))
+ (plist-get real-value :line-width)
+ real-value))
(and (integerp real-value) real-value)
- 1))
+ '(1 . 1)))
(color
(or (and (consp real-value) (plist-get real-value :color))
(and (stringp real-value) real-value)
nil))
(style
(and (consp real-value) (plist-get real-value :style))))
+ (if (integerp lwidth)
+ (setq lwidth (cons (abs lwidth) lwidth)))
(list :line-width lwidth :color color :style style))))
;; filter to make customized-value suitable for storing
(lambda (cus-value)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 1d344893a5a..04fb1dc6d06 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -73,9 +73,11 @@
'(choice
(const :tag "Frame default" t)
(const :tag "Filled box" box)
+ (cons :tag "Box with specified size"
+ (const box) integer)
(const :tag "Hollow cursor" hollow)
(const :tag "Vertical bar" bar)
- (cons :tag "Vertical bar with specified width"
+ (cons :tag "Vertical bar with specified height"
(const bar) integer)
(const :tag "Horizontal bar" hbar)
(cons :tag "Horizontal bar with specified width"
@@ -98,6 +100,11 @@
(ctl-arrow display boolean)
(truncate-lines display boolean)
(word-wrap display boolean)
+ (word-wrap-by-category
+ display boolean "28.1"
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (when value (require 'kinsoku))))
(selective-display-ellipses display boolean)
(indicate-empty-lines fringe boolean)
(indicate-buffer-boundaries
@@ -387,6 +394,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
;; (directory :format "%v"))))
(load-prefer-newer lisp boolean "24.4")
;; minibuf.c
+ (minibuffer-follows-selected-frame minibuffer boolean "28.1")
(enable-recursive-minibuffers minibuffer boolean)
(history-length minibuffer
(choice (const :tag "Infinite" t) integer)
@@ -622,7 +630,9 @@ since it could result in memory overflow and make Emacs crash."
(scroll-margin windows integer)
(maximum-scroll-margin windows float "26.1")
(hscroll-margin windows integer "22.1")
- (hscroll-step windows number "22.1")
+ (hscroll-step windows
+ (choice (const :tag "Center horizontally" nil)
+ number) "22.1")
(truncate-partial-width-windows
display
(choice (integer :tag "Truncate if narrower than")
@@ -782,7 +792,11 @@ since it could result in memory overflow and make Emacs crash."
"27.1"
:safe (lambda (value) (or (characterp value) (null value))))
;; xfaces.c
- (scalable-fonts-allowed display boolean "22.1")
+ (scalable-fonts-allowed
+ display (choice (const :tag "Don't allow scalable fonts" nil)
+ (const :tag "Allow any scalable font" t)
+ (repeat regexp))
+ "22.1")
;; xfns.c
(x-bitmap-file-path installation
(repeat (directory :format "%v")))
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index b0decfe7b72..dc463e05f92 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -419,14 +419,13 @@ It includes all variables in list VARS."
(widget-value child)
;; Child is null if the widget is closed (hidden).
(car (widget-get widget :shown-value)))))
- (when (boundp symbol)
- (unless (bolp)
- (princ "\n"))
- (princ " '(")
- (prin1 symbol)
- (princ " ")
- (prin1 (custom-quote value))
- (princ ")")))))
+ (unless (bolp)
+ (princ "\n"))
+ (princ " '(")
+ (prin1 symbol)
+ (princ " ")
+ (prin1 (custom-quote value))
+ (princ ")"))))
(if (bolp)
(princ " "))
(princ ")")
@@ -454,7 +453,7 @@ It includes all faces in list FACES."
;; Child is null if the widget is closed (hidden).
((widget-get widget :shown-value))
(t (custom-face-get-current-spec symbol)))))
- (when (and (facep symbol) value)
+ (when value
(princ (if (bolp) " '(" "\n '("))
(prin1 symbol)
(princ " ")
diff --git a/lisp/custom.el b/lisp/custom.el
index 885c486c5e4..3f1e8cacb28 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -758,6 +758,9 @@ Return non-nil if the `customized-value' property actually changed."
(progn (put symbol 'customized-value (list (custom-quote value)))
(custom-push-theme 'theme-value symbol 'user 'set
(custom-quote value)))
+ (custom-push-theme 'theme-value symbol 'user
+ (if (get symbol 'saved-value) 'set 'reset)
+ (custom-quote value))
(put symbol 'customized-value nil))
;; Changed?
(not (equal customized (get symbol 'customized-value)))))
@@ -904,7 +907,15 @@ See `custom-known-themes' for a list of known themes."
(boundp symbol))
(let ((sv (get symbol 'standard-value))
(val (symbol-value symbol)))
- (unless (and sv (equal (eval (car sv)) val))
+ (unless (or
+ ;; We only do this trick if the current value
+ ;; is different from the standard value.
+ (and sv (equal (eval (car sv)) val))
+ ;; And we don't do it if we would end up recording
+ ;; the same value for the user theme. This way we avoid
+ ;; having ((user VALUE) (changed VALUE)). That would be
+ ;; useless, because we don't disable the user theme.
+ (and (eq theme 'user) (equal (custom-quote val) value)))
(setq old `((changed ,(custom-quote val))))))))
(put symbol prop (cons (list theme value) old)))
(put theme 'theme-settings
@@ -999,7 +1010,10 @@ COMMENT is a comment string about SYMBOL."
set)
(when requests
(put symbol 'custom-requests requests)
- (mapc #'require requests))
+ ;; Load any libraries that the setting has specified as
+ ;; being required, but don't error out if the package has
+ ;; been removed.
+ (mapc (lambda (lib) (require lib nil t)) requests))
(setq set (or (get symbol 'custom-set) #'custom-set-default))
(put symbol 'saved-value (list value))
(put symbol 'saved-variable-comment comment)
@@ -1365,13 +1379,36 @@ function runs. To disable other themes, use `disable-theme'."
obarray (lambda (sym) (get sym 'theme-settings)) t))))
(unless (custom-theme-p theme)
(error "Undefined Custom theme %s" theme))
- (let ((settings (get theme 'theme-settings)))
+ (let ((settings (get theme 'theme-settings)) ; '(prop symbol theme value)
+ ;; We are enabling the theme, so don't inhibit enabling it. (Bug#34027)
+ (custom--inhibit-theme-enable nil))
;; Loop through theme settings, recalculating vars/faces.
(dolist (s settings)
(let* ((prop (car s))
- (symbol (cadr s))
- (spec-list (get symbol prop)))
- (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list)))
+ (symbol (cadr s))
+ (spec-list (get symbol prop))
+ (sv (get symbol 'standard-value))
+ (val (and (boundp symbol) (symbol-value symbol))))
+ ;; We can't call `custom-push-theme' when enabling the theme: it's not
+ ;; that the theme settings have changed, it's just that we want to
+ ;; enable those settings. But we might need to save a user setting
+ ;; outside of Customize, in order to get back to it when disabling
+ ;; the theme, just like in `custom-push-theme'.
+ (when (and (custom--should-apply-setting theme)
+ ;; Only do it for variables; for faces, using
+ ;; `face-new-frame-defaults' is enough.
+ (eq prop 'theme-value)
+ (boundp symbol)
+ (not (or spec-list
+ ;; Only if the current value is different from
+ ;; the standard value.
+ (and sv (equal (eval (car sv)) val))
+ ;; And only if the changed value is different
+ ;; from the new value under the user theme.
+ (and (eq theme 'user)
+ (equal (custom-quote val) (nth 3 s))))))
+ (setq spec-list `((changed ,(custom-quote val)))))
+ (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list)))
(cond
((eq prop 'theme-face)
(custom-theme-recalc-face symbol))
@@ -1440,7 +1477,7 @@ See `custom-enabled-themes' for a list of enabled themes."
(let* ((prop (car s))
(symbol (cadr s))
(val (assq-delete-all theme (get symbol prop))))
- (put symbol prop val)
+ (custom-push-theme prop symbol theme 'reset)
(cond
((eq prop 'theme-value)
(custom-theme-recalc-variable symbol))
@@ -1541,6 +1578,20 @@ Each of the arguments ARGS has this form:
This means reset VARIABLE. (The argument IGNORED is ignored)."
(apply #'custom-theme-reset-variables 'user args))
+(defun custom-add-choice (variable choice)
+ "Add CHOICE to the custom type of VARIABLE.
+If a choice with the same tag already exists, no action is taken."
+ (let ((choices (get variable 'custom-type)))
+ (unless (eq (car choices) 'choice)
+ (error "Not a choice type: %s" choices))
+ (unless (seq-find (lambda (elem)
+ (equal (caddr (member :tag elem))
+ (caddr (member :tag choice))))
+ (cdr choices))
+ ;; Put the new choice at the end.
+ (put variable 'custom-type
+ (append choices (list choice))))))
+
;;; The End.
(provide 'custom)
diff --git a/lisp/delim-col.el b/lisp/delim-col.el
index 9d520278a70..1d4358d7385 100644
--- a/lisp/delim-col.el
+++ b/lisp/delim-col.el
@@ -3,7 +3,7 @@
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
-;; Version: 2.1
+;; Old-Version: 2.1
;; Keywords: convenience text
;; X-URL: https://www.emacswiki.org/emacs/ViniciusJoseLatorre
diff --git a/lisp/delsel.el b/lisp/delsel.el
index 16886dfdb12..df2adc7aeba 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -217,6 +217,10 @@ With ARG, repeat that many times. `C-u' means until end of buffer."
(self-insert-command
(prefix-numeric-value current-prefix-arg))
(setq this-command 'ignore)))))
+ ;; If the user has quit here (for instance, if the user is
+ ;; presented with a "changed on disk; really edit the buffer?"
+ ;; prompt, but hit `C-g'), just ding.
+ (quit (ding))
;; If ask-user-about-supersession-threat signals an error,
;; stop safe_run_hooks from clearing out pre-command-hook.
(file-supersession (message "%s" (cadr data)) (ding))
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 1dbbd421489..677db2f68a9 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -54,10 +54,12 @@
(<= (length pp) (- (window-width) (current-column))))
(insert pp)
(insert-text-button
- "[Show]" 'action (lambda (&rest _ignore)
- (with-output-to-temp-buffer
- "*Pp Eval Output*"
- (princ pp)))
+ "[Show]"
+ 'follow-link t
+ 'action (lambda (&rest _ignore)
+ (with-output-to-temp-buffer
+ "*Pp Eval Output*"
+ (princ pp)))
'help-echo "mouse-2, RET: pretty print value in another buffer"))))
(defun describe-property-list (properties)
@@ -141,8 +143,7 @@ otherwise."
(wid-field (get-char-property pos 'field))
(wid-button (get-char-property pos 'button))
(wid-doc (get-char-property pos 'widget-doc))
- ;; If button.el is not loaded, we have no buttons in the text.
- (button (and (fboundp 'button-at) (button-at pos)))
+ (button (button-at pos))
(button-type (and button (button-type button)))
(button-label (and button (button-label button)))
(widget (or wid-field wid-button wid-doc)))
@@ -211,7 +212,7 @@ multilingual development.
This is a fairly large file, not typically present on GNU systems.
At the time of writing it is at the URL
-`http://www.unicode.org/Public/UNIDATA/UnicodeData.txt'."
+`https://www.unicode.org/Public/UNIDATA/UnicodeData.txt'."
:group 'mule
:version "22.1"
:type '(choice (const :tag "None" nil)
@@ -688,7 +689,8 @@ The character information includes:
(save-excursion (goto-char pos)
(looking-at-p "[ \t]+$")))
'trailing-whitespace)
- ((and nobreak-char-display char (eq char '#xa0))
+ ((and nobreak-char-display char
+ (eq (get-char-code-property char 'general-category) 'Zs))
'nobreak-space)
((and nobreak-char-display char
(memq char '(#xad #x2010 #x2011)))
@@ -763,6 +765,8 @@ The character information includes:
(to (nth 4 composition))
glyph)
(if (fontp font)
+ ;; GUI frame: show composition in terms of
+ ;; font glyphs and characters.
(progn
(insert " using this font:\n "
(symbol-name (font-get font :type))
@@ -772,12 +776,25 @@ The character information includes:
(while (and (<= from to)
(setq glyph (lgstring-glyph gstring from)))
(insert (format " %S\n" glyph))
- (setq from (1+ from))))
+ (setq from (1+ from)))
+ (when (and (stringp (car composition))
+ (string-match "\"\\([^\"]+\\)\"" (car composition)))
+ (insert "with these character(s):\n")
+ (let ((chars (match-string 1 (car composition))))
+ (dotimes (i (length chars))
+ (let ((char (aref chars i)))
+ (insert (format " %s (#x%x) %s\n"
+ (describe-char-padded-string char) char
+ (get-char-code-property
+ char 'name))))))))
+ ;; TTY frame: show composition in terms of characters.
(insert " by these characters:\n")
(while (and (<= from to)
(setq glyph (lgstring-glyph gstring from)))
- (insert (format " %c (#x%x)\n"
- (lglyph-char glyph) (lglyph-char glyph)))
+ (insert (format " %c (#x%x) %s\n"
+ (lglyph-char glyph) (lglyph-char glyph)
+ (get-char-code-property
+ (lglyph-char glyph) 'name)))
(setq from (1+ from)))))
(insert " by the rule:\n\t(")
(let ((first t))
@@ -919,7 +936,7 @@ condition, the function may return string longer than WIDTH, see
(t name)))))))
;;;###autoload
-(defun describe-char-eldoc ()
+(defun describe-char-eldoc (_callback &rest _)
"Return a description of character at point for use by ElDoc mode.
Return nil if character at point is a printable ASCII
@@ -929,10 +946,17 @@ Otherwise return a description formatted by
of `eldoc-echo-area-use-multiline-p' variable and width of
minibuffer window for width limit.
-This function is meant to be used as a value of
-`eldoc-documentation-function' variable."
+This function can be used as a value of
+`eldoc-documentation-functions' variable."
(let ((ch (following-char)))
(when (and (not (zerop ch)) (or (< ch 32) (> ch 127)))
+ ;; TODO: investigate if the new `eldoc-documentation-functions'
+ ;; API could significantly improve this. JT@2020-07-07: Indeed,
+ ;; instead of returning a string tailored here for the echo area
+ ;; exclusively, we could call the (now unused) argument
+ ;; _CALLBACK with hints on how to shorten the string if needed,
+ ;; or with multiple usable strings which ElDoc picks according
+ ;; to its space constraints.
(describe-char-eldoc--format
ch
(unless (eq eldoc-echo-area-use-multiline-p t)
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 94de6c885e5..7a7f1d07c93 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -344,7 +344,7 @@ to the value obtained by evaluating FORM."
Each element is a regular expression. Buffers with a name matched by any of
these won't be deleted."
:version "23.3" ; added Warnings - bug#6336
- :type '(repeat string)
+ :type '(repeat regexp)
:group 'desktop)
;;;###autoload
@@ -534,7 +534,7 @@ can guess how to load the mode's definition.")
'((defining-kbd-macro nil)
(isearch-mode nil)
(vc-mode nil)
- (vc-dired-mode nil)
+ (vc-dir-mode nil)
(erc-track-minor-mode nil)
(savehist-mode nil))
"Table mapping minor mode variables to minor mode functions.
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 2c421470a54..417477be27b 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -7,6 +7,7 @@
(defvar dframe-version "1.3"
"The current version of the dedicated frame library.")
+(make-obsolete-variable 'dframe-version nil "28.1")
;; This file is part of GNU Emacs.
@@ -286,6 +287,9 @@ CREATE-HOOK is a hook to run after creating a frame."
;; Correct use of `temp-buffer-show-function': Bob Weiner
(if (and (boundp 'temp-buffer-show-hook)
(boundp 'temp-buffer-show-function))
+ ;; FIXME: Doesn't this get us into an inf-loop when the
+ ;; `temp-buffer-show-function' runs `temp-buffer-show-hook'
+ ;; (as is normally the case)?
(progn (make-local-variable 'temp-buffer-show-hook)
(setq temp-buffer-show-hook temp-buffer-show-function)))
(make-local-variable 'temp-buffer-show-function)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 7f988540c2c..94a2bbf1f34 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -60,24 +60,132 @@ Isolated means that STRING is surrounded by spaces or at the beginning/end
of a string followed/prefixed with an space.
The regexp capture the preceding blank, STRING and the following blank as
the groups 1, 2 and 3 respectively."
- (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string))
+ (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string))
-(defun dired--star-or-qmark-p (string match &optional keep)
+(defun dired--star-or-qmark-p (string match &optional keep start)
"Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'.
MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter
means STRING contains either \"?\" or `\\=`?\\=`' or \"*\".
If optional arg KEEP is non-nil, then preserve the match data. Otherwise,
this function changes it and saves MATCH as the second match group.
+START is the position to start matching from.
Isolated means that MATCH is surrounded by spaces or at the beginning/end
of STRING followed/prefixed with an space. A match to `\\=`?\\=`',
isolated or not, is also valid."
- (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))))
+ (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))
(when (or (null match) (equal match "?"))
- (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps)))
- (cl-some (lambda (x)
- (funcall (if keep #'string-match-p #'string-match) x string))
- regexps)))
+ (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)"))
+ (funcall (if keep #'string-match-p #'string-match) regexp string start)))
+
+(defun dired--need-confirm-positions (command string)
+ "Search for non-isolated matches of STRING in COMMAND.
+Return a list of positions that match STRING, but would not be
+considered \"isolated\" by `dired--star-or-qmark-p'."
+ (cl-assert (= (length string) 1))
+ (let ((start 0)
+ (isolated-char-positions nil)
+ (confirm-positions nil)
+ (regexp (regexp-quote string)))
+ ;; Collect all ? and * surrounded by spaces and `?`.
+ (while (dired--star-or-qmark-p command string nil start)
+ (push (cons (match-beginning 2) (match-end 2))
+ isolated-char-positions)
+ (setq start (match-end 2)))
+ ;; Now collect any remaining ? and *.
+ (setq start 0)
+ (while (string-match regexp command start)
+ (unless (cl-member (match-beginning 0) isolated-char-positions
+ :test (lambda (pos match)
+ (<= (car match) pos (cdr match))))
+ (push (match-beginning 0) confirm-positions))
+ (setq start (match-end 0)))
+ confirm-positions))
+
+(defun dired--mark-positions (positions)
+ (let ((markers (make-string
+ (1+ (apply #'max positions))
+ ?\s)))
+ (dolist (pos positions)
+ (setf (aref markers pos) ?^))
+ markers))
+
+(defun dired--highlight-no-subst-chars (positions command mark)
+ (cl-callf substring-no-properties command)
+ (dolist (pos positions)
+ (add-face-text-property pos (1+ pos) 'warning nil command))
+ (if mark
+ (concat command "\n" (dired--mark-positions positions))
+ command))
+
+(defun dired--no-subst-explain (buf char-positions command mark-positions)
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert
+ (format-message "\
+If your command contains occurrences of `*' surrounded by
+whitespace, `dired-do-shell-command' substitutes them for the
+entire file list to process. Otherwise, if your command contains
+occurrences of `?' surrounded by whitespace or `%s', Dired will
+run the command once for each file, substituting `?' for each
+file name.
+
+Your command contains occurrences of `%s' that will not be
+substituted, and will be passed through normally to the shell.
+
+%s
+
+(Press ^ to %s markers below these occurrences.)
+"
+ "`"
+ (string (aref command (car char-positions)))
+ (dired--highlight-no-subst-chars char-positions command mark-positions)
+ (if mark-positions "remove" "add")))))
+
+(defun dired--no-subst-ask (char nb-occur details)
+ (let ((hilit-char (propertize (string char) 'face 'warning))
+ (choices `(?y ?n ?? ,@(when details '(?^)))))
+ (read-char-from-minibuffer
+ (format-message
+ (ngettext
+ "%d occurrence of `%s' will not be substituted. Proceed? (%s) "
+ "%d occurrences of `%s' will not be substituted. Proceed? (%s) "
+ nb-occur)
+ nb-occur hilit-char (mapconcat #'string choices ", "))
+ choices)))
+
+(defun dired--no-subst-confirm (char-positions command)
+ (let ((help-buf (get-buffer-create "*Dired help*"))
+ (char (aref command (car char-positions)))
+ (nb-occur (length char-positions))
+ (done nil)
+ (details nil)
+ (markers nil)
+ proceed)
+ (unwind-protect
+ (save-window-excursion
+ (while (not done)
+ (cl-case (dired--no-subst-ask char nb-occur details)
+ (?y
+ (setq done t
+ proceed t))
+ (?n
+ (setq done t
+ proceed nil))
+ (??
+ (if details
+ (progn
+ (quit-window nil details)
+ (setq details nil))
+ (dired--no-subst-explain
+ help-buf char-positions command markers)
+ (setq details (display-buffer help-buf))))
+ (?^
+ (setq markers (not markers))
+ (dired--no-subst-explain
+ help-buf char-positions command markers)))))
+ (kill-buffer help-buf))
+ proceed))
;;;###autoload
(defun dired-diff (file &optional switches)
@@ -134,16 +242,27 @@ the string of command switches used as the third argument of `diff'."
(file-name-directory default)
(dired-current-directory))
(dired-dwim-target-directory)))
- (defaults (dired-dwim-target-defaults (list current) target-dir)))
+ (defaults (append
+ (if (backup-file-name-p current)
+ ;; This is a backup file -- put the other
+ ;; main file, and the other backup files into
+ ;; the `M-n' list.
+ (delete (expand-file-name current)
+ (cons (expand-file-name
+ (file-name-sans-versions current))
+ (file-backup-file-names
+ (file-name-sans-versions current))))
+ ;; Non-backup file -- use the backup files as
+ ;; `M-n' candidates.
+ (file-backup-file-names current))
+ (dired-dwim-target-defaults (list current) target-dir))))
(list
(minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function) nil)
(setq minibuffer-default defaults))
- (read-file-name
- (format "Diff %s with%s: " current
- (if default (format " (default %s)" default) ""))
- target-dir default t))
+ (read-file-name (format-prompt "Diff %s with" default current)
+ target-dir default t))
(if current-prefix-arg
(read-string "Options for diff: "
(if (stringp diff-switches)
@@ -205,7 +324,10 @@ Examples of PREDICATE:
(not (and (= (file-attribute-user-id fa1) - mark files with different UID
(file-attribute-user-id fa2))
(= (file-attribute-group-id fa1) - and GID.
- (file-attribute-group-id fa2))))"
+ (file-attribute-group-id fa2))))
+
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil."
(interactive
(list
(let* ((target-dir (dired-dwim-target-directory))
@@ -409,7 +531,8 @@ has no effect on MS-Windows."
(set-file-modes
file
(if num-modes num-modes
- (file-modes-symbolic-to-number modes (file-modes file)))))
+ (file-modes-symbolic-to-number modes (file-modes file 'nofollow)))
+ 'nofollow))
(dired-do-redisplay arg)))
;;;###autoload
@@ -684,7 +807,7 @@ are executed in the background on each file sequentially waiting
for each command to terminate before running the next command.
In shell syntax this means separating the individual commands with `;'.
-The output appears in the buffer `*Async Shell Command*'."
+The output appears in the buffer named by `shell-command-buffer-name-async'."
(interactive
(let ((files (dired-get-marked-files t current-prefix-arg nil nil t)))
(list
@@ -722,16 +845,16 @@ it, write `*\"\"' in place of just `*'. This is equivalent to just
`*' in the shell, but avoids Dired's special handling.
If COMMAND ends in `&', `;', or `;&', it is executed in the
-background asynchronously, and the output appears in the buffer
-`*Async Shell Command*'. When operating on multiple files and COMMAND
-ends in `&', the shell command is executed on each file in parallel.
-However, when COMMAND ends in `;' or `;&' then commands are executed
-in the background on each file sequentially waiting for each command
-to terminate before running the next command. You can also use
-`dired-do-async-shell-command' that automatically adds `&'.
+background asynchronously, and the output appears in the buffer named
+by `shell-command-buffer-name-async'. When operating on multiple files
+and COMMAND ends in `&', the shell command is executed on each file
+in parallel. However, when COMMAND ends in `;' or `;&', then commands
+are executed in the background on each file sequentially waiting for
+each command to terminate before running the next command. You can
+also use `dired-do-async-shell-command' that automatically adds `&'.
Otherwise, COMMAND is executed synchronously, and the output
-appears in the buffer `*Shell Command Output*'.
+appears in the buffer named by `shell-command-buffer-name'.
This feature does not try to redisplay Dired buffers afterward, as
there's no telling what files COMMAND may have changed.
@@ -757,28 +880,19 @@ prompted for the shell command to use interactively."
(dired-read-shell-command "! on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (cl-flet ((need-confirm-p
- (cmd str)
- (let ((res cmd)
- (regexp (regexp-quote str)))
- ;; Drop all ? and * surrounded by spaces and `?`.
- (while (and (string-match regexp res)
- (dired--star-or-qmark-p res str))
- (setq res (replace-match "" t t res 2)))
- (string-match regexp res))))
(let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep)))
(no-subst (not (dired--star-or-qmark-p command "?" 'keep)))
+ (confirmations nil)
;; Get confirmation for wildcards that may have been meant
;; to control substitution of a file name or the file name list.
- (ok (cond ((not (or on-each no-subst))
- (error "You can not combine `*' and `?' substitution marks"))
- ((need-confirm-p command "*")
- (y-or-n-p (format-message
- "Confirm--do you mean to use `*' as a wildcard? ")))
- ((need-confirm-p command "?")
- (y-or-n-p (format-message
- "Confirm--do you mean to use `?' as a wildcard? ")))
- (t))))
+ (ok (cond
+ ((not (or on-each no-subst))
+ (error "You can not combine `*' and `?' substitution marks"))
+ ((setq confirmations (dired--need-confirm-positions command "*"))
+ (dired--no-subst-confirm confirmations command))
+ ((setq confirmations (dired--need-confirm-positions command "?"))
+ (dired--no-subst-confirm confirmations command))
+ (t))))
(cond ((not ok) (message "Command canceled"))
(t
(if on-each
@@ -789,7 +903,7 @@ prompted for the shell command to use interactively."
nil file-list)
;; execute the shell command
(dired-run-shell-command
- (dired-shell-stuff-it command file-list nil arg))))))))
+ (dired-shell-stuff-it command file-list nil arg)))))))
;; Might use {,} for bash or csh:
(defvar dired-mark-prefix ""
@@ -948,13 +1062,17 @@ With a prefix argument, kill that many lines starting with the current line.
"Kill all marked lines (not the files).
With a prefix argument, kill that many lines starting with the current line.
\(A negative argument kills backward.)
+
If you use this command with a prefix argument to kill the line
for a file that is a directory, which you have inserted in the
Dired buffer as a subdirectory, then it deletes that subdirectory
from the buffer as well.
+
To kill an entire subdirectory \(without killing its line in the
parent directory), go to its directory header line and use this
-command with a prefix argument (the value does not matter)."
+command with a prefix argument (the value does not matter).
+
+To undo the killing, the undo command can be used as normally."
;; Returns count of killed lines. FMT="" suppresses message.
(interactive "P")
(if arg
@@ -1006,8 +1124,8 @@ command with a prefix argument (the value does not matter)."
(defvar dired-compress-file-suffixes
'(
;; "tar -zxf" isn't used because it's not available on the
- ;; Solaris10 version of tar. Solaris10 becomes obsolete in 2021.
- ;; Same thing on AIX 7.1.
+ ;; Solaris 10 version of tar (obsolete in 2024?).
+ ;; Same thing on AIX 7.1 (obsolete 2023?) and 7.2 (obsolete 2022?).
("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -")
("\\.tgz\\'" "" "gzip -dc %i | tar -xf -")
("\\.gz\\'" "" "gunzip")
@@ -1060,8 +1178,6 @@ corresponding command.
Within CMD, %i denotes the input file(s), and %o denotes the
output file. %i path(s) are relative, while %o is absolute.")
-(declare-function format-spec "format-spec.el" (format specification))
-
;;;###autoload
(defun dired-do-compress-to ()
"Compress selected files and directories to an archive.
@@ -1069,7 +1185,6 @@ Prompt for the archive file name.
Choose the archiving command based on the archive file-name extension
and `dired-compress-files-alist'."
(interactive)
- (require 'format-spec)
(let* ((in-files (dired-get-marked-files nil nil nil nil t))
(out-file (expand-file-name (read-file-name "Compress to: ")))
(rule (cl-find-if
@@ -1089,12 +1204,12 @@ and `dired-compress-files-alist'."
(when (zerop
(dired-shell-command
(format-spec (cdr rule)
- `((?\o . ,(shell-quote-argument out-file))
- (?\i . ,(mapconcat
- (lambda (file-desc)
- (shell-quote-argument (file-name-nondirectory
- file-desc)))
- in-files " "))))))
+ `((?o . ,(shell-quote-argument out-file))
+ (?i . ,(mapconcat
+ (lambda (in-file)
+ (shell-quote-argument
+ (file-name-nondirectory in-file)))
+ in-files " "))))))
(message (ngettext "Compressed %d file to %s"
"Compressed %d files to %s"
(length in-files))
@@ -1265,7 +1380,7 @@ return t; if SYM is q or ESC, return nil."
(format " [Type yn!q or %s] "
(key-description (vector help-char)))
" [Type y, n, q or !] ")))
- (set sym (setq char (read-char-choice prompt char-choices)))
+ (set sym (setq char (read-char-from-minibuffer prompt char-choices)))
(if (memq char '(?y ?\s ?!)) t)))))
@@ -1531,17 +1646,13 @@ files matching `dired-omit-regexp'."
;;;###autoload
(defun dired-remove-file (file)
+ "Remove entry FILE on each dired buffer.
+Note this doesn't delete FILE in the file system.
+See `dired-delete-file' in case you wish that."
(dired-fun-in-all-buffers
(file-name-directory file) (file-name-nondirectory file)
#'dired-remove-entry file))
-(defun dired-remove-entry (file)
- (save-excursion
- (and (dired-goto-file file)
- (let (buffer-read-only)
- (delete-region (progn (beginning-of-line) (point))
- (line-beginning-position 2))))))
-
;;;###autoload
(defun dired-relist-file (file)
"Create or update the line for FILE in all Dired buffers it would belong in."
@@ -1599,7 +1710,7 @@ Special value `always' suppresses confirmation."
(defun dired-copy-file (from to ok-flag)
(dired-handle-overwrite to)
(dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
- dired-recursive-copies))
+ dired-recursive-copies dired-copy-dereference))
(declare-function make-symbolic-link "fileio.c")
@@ -1622,7 +1733,8 @@ If `ask', ask for user confirmation."
(dired-create-directory dir))))
(defun dired-copy-file-recursive (from to ok-flag &optional
- preserve-time top recursive)
+ preserve-time top recursive
+ dereference)
(when (and (eq t (file-attribute-type (file-attributes from)))
(file-in-directory-p to from))
(error "Cannot copy `%s' into its subdirectory `%s'" from to))
@@ -1634,7 +1746,8 @@ If `ask', ask for user confirmation."
(copy-directory from to preserve-time)
(or top (dired-handle-overwrite to))
(condition-case err
- (if (stringp (file-attribute-type attrs))
+ (if (and (not dereference)
+ (stringp (file-attribute-type attrs)))
;; It is a symlink
(make-symbolic-link (file-attribute-type attrs) to ok-flag)
(dired-maybe-create-dirs (file-name-directory to))
@@ -1656,6 +1769,9 @@ rename them using `vc-rename-file'."
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)
+ "Rename FILE to NEWNAME.
+Signal a `file-already-exists' error if a file NEWNAME already exists
+unless OK-IF-ALREADY-EXISTS is non-nil."
(dired-handle-overwrite newname)
(dired-maybe-create-dirs (file-name-directory newname))
(if (and dired-vc-rename-file
@@ -1670,7 +1786,8 @@ rename them using `vc-rename-file'."
(set-visited-file-name newname nil t)))
(dired-remove-file file)
;; See if it's an inserted subdir, and rename that, too.
- (dired-rename-subdir file newname))
+ (when (file-directory-p file)
+ (dired-rename-subdir file newname)))
(defun dired-rename-subdir (from-dir to-dir)
(setq from-dir (file-name-as-directory from-dir)
@@ -1685,7 +1802,7 @@ rename them using `vc-rename-file'."
(if (and buffer-file-name
(dired-in-this-tree-p buffer-file-name expanded-from-dir))
(let ((modflag (buffer-modified-p))
- (to-file (dired-replace-in-string
+ (to-file (replace-regexp-in-string
(concat "^" (regexp-quote from-dir))
to-dir
buffer-file-name)))
@@ -1749,7 +1866,7 @@ rename them using `vc-rename-file'."
;; Update buffer-local dired-subdir-alist and dired-switches-alist
(let ((cons (assoc-string (car elt) dired-switches-alist))
(cur-dir (dired-normalize-subdir
- (dired-replace-in-string regexp newtext (car elt)))))
+ (replace-regexp-in-string regexp newtext (car elt)))))
(setcar elt cur-dir)
(when cons (setcar cons cur-dir))))))
@@ -1973,6 +2090,10 @@ Optional arg HOW-TO determines how to treat the target.
(apply (car into-dir) operation rfn-list fn-list target (cdr into-dir))
(if (not (or dired-one-file into-dir))
(error "Marked %s: target must be a directory: %s" operation target))
+ (if (and (not (file-directory-p (car fn-list)))
+ (not (file-directory-p target))
+ (directory-name-p target))
+ (error "%s: Target directory does not exist: %s" operation target))
;; rename-file bombs when moving directories unless we do this:
(or into-dir (setq target (directory-file-name target)))
(dired-create-files
@@ -2156,6 +2277,9 @@ See HOW-TO argument for `dired-do-create-files'.")
;;;###autoload
(defun dired-do-copy (&optional arg)
"Copy all marked (or next ARG) files, or copy the current file.
+ARG has to be numeric for above functionality. See
+`dired-get-marked-files' for more details.
+
When operating on just the current file, prompt for the new name.
When operating on multiple or marked files, prompt for a target
@@ -2169,10 +2293,18 @@ If `dired-copy-preserve-time' is non-nil, this command preserves
the modification time of each old file in the copy, similar to
the \"-p\" option for the \"cp\" shell command.
-This command copies symbolic links by creating new ones, similar
-to the \"-d\" option for the \"cp\" shell command."
+This command copies symbolic links by creating new ones,
+similar to the \"-d\" option for the \"cp\" shell command.
+But if `dired-copy-dereference' is non-nil, the symbolic
+links are dereferenced and then copied, similar to the \"-L\"
+option for the \"cp\" shell command. If ARG is a cons with
+element 4 (`\\[universal-argument]'), the inverted value of
+`dired-copy-dereference' will be used."
(interactive "P")
- (let ((dired-recursive-copies dired-recursive-copies))
+ (let ((dired-recursive-copies dired-recursive-copies)
+ (dired-copy-dereference (if (equal arg '(4))
+ (not dired-copy-dereference)
+ dired-copy-dereference)))
(dired-do-create-files 'copy #'dired-copy-file
"Copy"
arg dired-keep-marker-copy
@@ -2480,7 +2612,7 @@ This function takes some pains to conform to `ls -lR' output."
(push (cons dirname switches) dired-switches-alist)))
(when switches-have-R
(dired-build-subdir-alist switches)
- (setq switches (dired-replace-in-string "R" "" switches))
+ (setq switches (string-replace "R" "" switches))
(dolist (cur-ass dired-subdir-alist)
(let ((cur-dir (car cur-ass)))
(and (dired-in-this-tree-p cur-dir dirname)
@@ -2581,7 +2713,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
(let ((dired-actual-switches
(or switches
dired-subdir-switches
- (dired-replace-in-string "R" "" dired-actual-switches))))
+ (string-replace "R" "" dired-actual-switches))))
(if (equal dirname (car (car (last dired-subdir-alist))))
;; If doing the top level directory of the buffer,
;; redo it as specified in dired-directory.
@@ -2685,12 +2817,6 @@ When called interactively and not on a subdir line, go to this subdir's line."
(if (dired-get-subdir) 1 0))))
(dired-next-subdir (- arg) no-error-if-not-found no-skip))
-(defun dired-subdir-min ()
- (save-excursion
- (if (not (dired-prev-subdir 0 t t))
- (error "Not in a subdir!")
- (point))))
-
;;;###autoload
(defun dired-goto-subdir (dir)
"Go to end of header line of DIR in this dired buffer.
@@ -2783,15 +2909,6 @@ Lower levels are unaffected."
;;; hiding
-(defun dired-unhide-subdir ()
- (with-silent-modifications
- (dired--unhide (dired-subdir-min) (dired-subdir-max))))
-
-(defun dired-subdir-hidden-p (dir)
- (save-excursion
- (dired-goto-subdir dir)
- (dired--hidden-p)))
-
;;;###autoload
(defun dired-hide-subdir (arg)
"Hide or unhide the current subdirectory and move to next directory.
@@ -3045,6 +3162,69 @@ instead."
(backward-delete-char 1))
(message "%s" (buffer-string)))))
+
+;;; Version control from dired
+
+(declare-function vc-dir-unmark-all-files "vc-dir")
+(declare-function vc-dir-mark-files "vc-dir")
+
+;;;###autoload
+(defun dired-vc-next-action (verbose)
+ "Do the next version control operation on marked files/directories.
+When only files are marked then call `vc-next-action' with the
+same value of the VERBOSE argument.
+When also directories are marked then call `vc-dir' and mark
+the same files/directories in the VC-Dir buffer that were marked
+in the Dired buffer."
+ (interactive "P")
+ (let* ((marked-files
+ (dired-get-marked-files nil nil nil nil t))
+ (mark-files
+ (when (cl-some #'file-directory-p marked-files)
+ ;; Fix deficiency of Dired by adding slash to dirs
+ (mapcar (lambda (file)
+ (if (file-directory-p file)
+ (file-name-as-directory file)
+ file))
+ marked-files))))
+ (if mark-files
+ (let ((transient-hook (make-symbol "vc-dir-mark-files")))
+ (fset transient-hook
+ (lambda ()
+ (remove-hook 'vc-dir-refresh-hook transient-hook t)
+ (vc-dir-unmark-all-files t)
+ (vc-dir-mark-files mark-files)))
+ (vc-dir-root)
+ (add-hook 'vc-dir-refresh-hook transient-hook nil t))
+ (vc-next-action verbose))))
+
+(declare-function vc-compatible-state "vc")
+
+;;;###autoload
+(defun dired-vc-deduce-fileset (&optional state-model-only-files not-state-changing)
+ (let ((backend (vc-responsible-backend default-directory))
+ (files (dired-get-marked-files nil nil nil nil t))
+ only-files-list
+ state
+ model)
+ (when (and (not not-state-changing) (cl-some #'file-directory-p files))
+ (user-error "State changing VC operations on directories supported only in `vc-dir'"))
+
+ (when state-model-only-files
+ (setq only-files-list (mapcar (lambda (file) (cons file (vc-state file))) files))
+ (setq state (cdar only-files-list))
+ ;; Check that all files are in a consistent state, since we use that
+ ;; state to decide which operation to perform.
+ (dolist (crt (cdr only-files-list))
+ (unless (vc-compatible-state (cdr crt) state)
+ (error "When applying VC operations to multiple files, the files are required\nto be in similar VC states.\n%s in state %s clashes with %s in state %s"
+ (car crt) (cdr crt) (caar only-files-list) state)))
+ (setq only-files-list (mapcar 'car only-files-list))
+ (when (and state (not (eq state 'unregistered)))
+ (setq model (vc-checkout-model backend only-files-list))))
+ (list backend files only-files-list state model)))
+
+
(provide 'dired-aux)
;; Local Variables:
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 623a1dd3255..55077e71882 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -64,21 +64,8 @@ mbox format, and so cannot be distinguished in this way."
:type 'boolean
:group 'dired-keys)
-(defcustom dired-bind-jump t
- "Non-nil means bind `dired-jump' to C-x C-j, otherwise do not.
-Setting this variable directly after dired-x is loaded has no effect -
-use \\[customize]."
- :type 'boolean
- :set (lambda (sym val)
- (if (set sym val)
- (progn
- (define-key ctl-x-map "\C-j" 'dired-jump)
- (define-key ctl-x-4-map "\C-j" 'dired-jump-other-window))
- (if (eq 'dired-jump (lookup-key ctl-x-map "\C-j"))
- (define-key ctl-x-map "\C-j" nil))
- (if (eq 'dired-jump-other-window (lookup-key ctl-x-4-map "\C-j"))
- (define-key ctl-x-4-map "\C-j" nil))))
- :group 'dired-keys)
+(defvar dired-bind-jump t)
+(make-obsolete-variable 'dired-bind-jump "not used." "28.1")
(defcustom dired-bind-man t
"Non-nil means bind `dired-man' to \"N\" in Dired, otherwise do not.
@@ -137,6 +124,7 @@ folding to be used on case-insensitive filesystems only."
(file-name-case-insensitive-p dir)
dired-omit-case-fold))
+;;;###autoload
(define-minor-mode dired-omit-mode
"Toggle omission of uninteresting files in Dired (Dired-Omit mode).
@@ -307,7 +295,6 @@ To see the options you can set, use M-x customize-group RET dired-x RET.
See also the functions:
`dired-flag-extension'
`dired-virtual'
- `dired-jump'
`dired-man'
`dired-vm'
`dired-rmail'
@@ -326,21 +313,19 @@ See also the functions:
(when file
(file-name-extension file))))
(suffix
- (read-string (format "%s extension%s: "
- (if (equal current-prefix-arg '(4))
- "UNmarking"
- "Marking")
- (if default
- (format " (default %s)" default)
- "")) nil nil default))
+ (read-string (format-prompt
+ "%s extension" default
+ (if (equal current-prefix-arg '(4))
+ "UNmarking"
+ "Marking"))
+ nil nil default))
(marker
(pcase current-prefix-arg
('(4) ?\s)
('(16)
(let* ((dflt (char-to-string dired-marker-char))
(input (read-string
- (format
- "Marker character to use (default %s): " dflt)
+ (format-prompt "Marker character to use" dflt)
nil nil dflt)))
(aref input 0)))
(_ dired-marker-char))))
@@ -447,68 +432,7 @@ See variables `dired-texinfo-unclean-extensions',
dired-bibtex-unclean-extensions
dired-tex-unclean-extensions
(list ".dvi"))))
-
-(defvar archive-superior-buffer)
-(defvar tar-superior-buffer)
-;;; JUMP.
-;;;###autoload
-(defun dired-jump (&optional other-window file-name)
- "Jump to Dired buffer corresponding to current buffer.
-If in a file, Dired the current directory and move to file's line.
-If in Dired already, pop up a level and goto old directory's line.
-In case the proper Dired file line cannot be found, refresh the dired
-buffer and try again.
-When OTHER-WINDOW is non-nil, jump to Dired buffer in other window.
-When FILE-NAME is non-nil, jump to its line in Dired.
-Interactively with prefix argument, read FILE-NAME."
- (interactive
- (list nil (and current-prefix-arg
- (read-file-name "Jump to Dired file: "))))
- (cond
- ((and (bound-and-true-p archive-subfile-mode)
- (buffer-live-p archive-superior-buffer))
- (switch-to-buffer archive-superior-buffer))
- ((and (bound-and-true-p tar-subfile-mode)
- (buffer-live-p tar-superior-buffer))
- (switch-to-buffer tar-superior-buffer))
- (t
- ;; Expand file-name before `dired-goto-file' call:
- ;; `dired-goto-file' requires its argument to be an absolute
- ;; file name; the result of `read-file-name' could be
- ;; an abbreviated file name (Bug#24409).
- (let* ((file (or (and file-name (expand-file-name file-name))
- buffer-file-name))
- (dir (if file (file-name-directory file) default-directory)))
- (if (and (eq major-mode 'dired-mode) (null file-name))
- (progn
- (setq dir (dired-current-directory))
- (dired-up-directory other-window)
- (unless (dired-goto-file dir)
- ;; refresh and try again
- (dired-insert-subdir (file-name-directory dir))
- (dired-goto-file dir)))
- (if other-window
- (dired-other-window dir)
- (dired dir))
- (if file
- (or (dired-goto-file file)
- ;; refresh and try again
- (progn
- (dired-insert-subdir (file-name-directory file))
- (dired-goto-file file))
- ;; Toggle omitting, if it is on, and try again.
- (when dired-omit-mode
- (dired-omit-mode)
- (dired-goto-file file)))))))))
-
-;;;###autoload
-(defun dired-jump-other-window (&optional file-name)
- "Like \\[dired-jump] (`dired-jump') but in other window."
- (interactive
- (list (and current-prefix-arg
- (read-file-name "Jump to Dired file: "))))
- (dired-jump t file-name))
;;; OMITTING.
@@ -623,7 +547,9 @@ interactively, prompt for REGEXP.
With prefix argument, unflag all those files.
Optional fourth argument LOCALP is as in `dired-get-filename'.
Optional fifth argument CASE-FOLD-P specifies the value of
-`case-fold-search' used for matching REGEXP."
+`case-fold-search' used for matching REGEXP.
+If the region is active in Transient Mark mode, operate only on
+files in the active region if `dired-mark-region' is non-nil."
(interactive
(list (read-regexp
"Mark unmarked files matching regexp (default all): "
@@ -1386,7 +1312,9 @@ present for some values of `ls-lisp-emulation'.
This function operates only on the buffer content and does not
refer at all to the underlying file system. Contrast this with
-`find-dired', which might be preferable for the task at hand."
+`find-dired', which might be preferable for the task at hand.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil."
;; Using sym="" instead of nil avoids the trap of
;; (string-match "foo" sym) into which a user would soon fall.
;; Give `equal' instead of `=' in the example, as this works on
@@ -1555,7 +1483,9 @@ a prefix argument, when it offers the filename near point as a default."
;;; Internal functions.
;; Fixme: This should probably use `thing-at-point'. -- fx
-(defun dired-filename-at-point ()
+(define-obsolete-function-alias 'dired-filename-at-point
+ #'dired-x-guess-file-name-at-point "28.1")
+(defun dired-x-guess-file-name-at-point ()
"Return the filename closest to point, expanded.
Point should be in or after a filename."
(save-excursion
@@ -1589,7 +1519,7 @@ Point should be in or after a filename."
"Return filename prompting with PROMPT with completion.
If `current-prefix-arg' is non-nil, uses name at point as guess."
(if current-prefix-arg
- (let ((guess (dired-filename-at-point)))
+ (let ((guess (dired-x-guess-file-name-at-point)))
(read-file-name prompt
(file-name-directory guess)
guess
diff --git a/lisp/dired.el b/lisp/dired.el
index 4d0c2abdf55..08b19a02250 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -77,6 +77,27 @@ If nil, `dired-listing-switches' is used."
:type '(choice (const :tag "Use dired-listing-switches" nil)
(string :tag "Switches")))
+(defcustom dired-maybe-use-globstar nil
+ "If non-nil, enable globstar if the shell supports it.
+Some shells enable this feature by default (e.g. zsh or fish).
+
+See `dired-enable-globstar-in-shell' for a list of shells
+that support globstar and disable it by default.
+
+Note that the implementations of globstar have small differences
+between shells. You must check your shell documentation to see
+what to expect."
+ :type 'boolean
+ :group 'dired
+ :version "28.1")
+
+(defconst dired-enable-globstar-in-shell
+ '(("ksh" . "set -G")
+ ("bash" . "shopt -s globstar"))
+ "Alist of (SHELL . COMMAND), where COMMAND enables globstar in SHELL.
+If `dired-maybe-use-globstar' is non-nil, then `dired-insert-directory'
+checks this alist to enable globstar in the shell subprocess.")
+
(defcustom dired-chown-program
(purecopy (cond ((executable-find "chown") "chown")
((file-executable-p "/usr/sbin/chown") "/usr/sbin/chown")
@@ -125,7 +146,7 @@ For more details, see Info node `(emacs)ls in Lisp'."
"Informs Dired about how `ls -lF' marks symbolic links.
Set this to t if `ls' (or whatever program is specified by
`insert-directory-program') with `-lF' marks the symbolic link
-itself with a trailing @ (usually the case under Ultrix).
+itself with a trailing @ (usually the case under Ultrix and macOS).
Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
nil (the default), if it gives `bar@ -> foo', set it to t.
@@ -216,6 +237,12 @@ The target is used in the prompt for file copy, rename etc."
:type 'boolean
:group 'dired)
+(defcustom dired-copy-dereference nil
+ "If non-nil, Dired dereferences symlinks when copying them.
+This is similar to the \"-L\" option for the \"cp\" shell command."
+ :type 'boolean
+ :group 'dired)
+ ;
; These variables were deleted and the replacements are on files.el.
; We leave aliases behind for back-compatibility.
(define-obsolete-variable-alias 'dired-free-space-program
@@ -230,6 +257,8 @@ The target is used in the prompt for file copy, rename etc."
You can customize key bindings or load extensions with this."
:group 'dired
:type 'hook)
+(make-obsolete-variable 'dired-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom dired-mode-hook nil
"Run at the very end of `dired-mode'."
@@ -294,6 +323,36 @@ new Dired buffers."
:version "26.1"
:group 'dired)
+(defcustom dired-mark-region 'file
+ "Defines what commands that mark files do with the active region.
+
+When nil, marking commands don't operate on all files in the
+active region. They process their prefix arguments as usual.
+
+When the value of this option is non-nil, then all Dired commands
+that mark or unmark files will operate on all files in the region
+if the region is active in Transient Mark mode.
+
+When `file', the region marking is based on the file name.
+This means don't mark the file if the end of the region is
+before the file name displayed on the Dired line, so the file name
+is visually outside the region. This behavior is consistent with
+marking files without the region using the key `m' that advances
+point to the next line after marking the file. Thus the number
+of keys used to mark files is the same as the number of keys
+used to select the region, e.g. `M-2 m' marks 2 files, and
+`C-SPC M-2 n m' marks 2 files, and `M-2 S-down m' marks 2 files.
+
+When `line', the region marking is based on Dired lines,
+so include the file into marking if the end of the region
+is anywhere on its Dired line, except the beginning of the line."
+ :type '(choice
+ (const :tag "Don't mark files in active region" nil)
+ (const :tag "Exclude file name outside of region" file)
+ (const :tag "Include the file at region end line" line))
+ :group 'dired
+ :version "28.1")
+
;; Internal variables
(defvar dired-marker-char ?* ; the answer is 42
@@ -475,6 +534,14 @@ Subexpression 2 must end right before the \\n.")
(defvar dired-symlink-face 'dired-symlink
"Face name used for symbolic links.")
+(defface dired-broken-symlink
+ '((((class color))
+ :foreground "yellow1" :background "red1" :weight bold)
+ (t :weight bold :slant italic :underline t))
+ "Face used for broken symbolic links."
+ :group 'dired-faces
+ :version "28.1")
+
(defface dired-special
'((t (:inherit font-lock-variable-name-face)))
"Face used for sockets, pipes, block devices and char devices."
@@ -538,6 +605,20 @@ Subexpression 2 must end right before the \\n.")
(list dired-re-dir
'(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
;;
+ ;; Broken Symbolic link.
+ (list dired-re-sym
+ (list (lambda (end)
+ (let* ((file (dired-file-name-at-point))
+ (truename (ignore-errors (file-truename file))))
+ ;; either not existent target or circular link
+ (and (not (and truename (file-exists-p truename)))
+ (search-forward-regexp "\\(.+\\) \\(->\\) ?\\(.+\\)" end t))))
+ '(dired-move-to-filename)
+ nil
+ '(1 'dired-broken-symlink)
+ '(2 dired-symlink-face)
+ '(3 'dired-broken-symlink)))
+ ;;
;; Symbolic link to a directory.
(list dired-re-sym
(list (lambda (end)
@@ -610,12 +691,20 @@ Subexpression 2 must end right before the \\n.")
PREDICATE is evaluated on each line, with point at beginning of line.
MSG is a noun phrase for the type of files being marked.
It should end with a noun that can be pluralized by adding `s'.
+
+In Transient Mark mode, if the mark is active, operate on the contents
+of the region if `dired-mark-region' is non-nil. Otherwise, operate
+on the whole buffer.
+
Return value is the number of files marked, or nil if none were marked."
- `(let ((inhibit-read-only t) count)
+ `(let ((inhibit-read-only t) count
+ (use-region-p (dired-mark--region-use-p))
+ (beg (dired-mark--region-beginning))
+ (end (dired-mark--region-end)))
(save-excursion
(setq count 0)
(when ,msg
- (message "%s %ss%s..."
+ (message "%s %ss%s%s..."
(cond ((eq dired-marker-char ?\s) "Unmarking")
((eq dired-del-marker dired-marker-char)
"Flagging")
@@ -623,22 +712,28 @@ Return value is the number of files marked, or nil if none were marked."
,msg
(if (eq dired-del-marker dired-marker-char)
" for deletion"
- "")))
- (goto-char (point-min))
- (while (not (eobp))
+ "")
+ (if use-region-p
+ " in region"
+ "")))
+ (goto-char beg)
+ (while (< (point) end)
(when ,predicate
(unless (= (following-char) dired-marker-char)
(delete-char 1)
(insert dired-marker-char)
(setq count (1+ count))))
(forward-line 1))
- (when ,msg (message "%s %s%s %s%s"
+ (when ,msg (message "%s %s%s %s%s%s"
count
,msg
(dired-plural-s count)
(if (eq dired-marker-char ?\s) "un" "")
(if (eq dired-marker-char dired-del-marker)
- "flagged" "marked"))))
+ "flagged" "marked")
+ (if use-region-p
+ " in region"
+ ""))))
(and (> count 0) count)))
(defmacro dired-map-over-marks (body arg &optional show-progress
@@ -757,6 +852,32 @@ ERROR can be a string with the error message."
(user-error (if (stringp error) error "No files specified")))
result))
+(defun dired-mark--region-use-p ()
+ "Whether Dired marking commands should act on region."
+ (and dired-mark-region
+ (region-active-p)
+ (> (region-end) (region-beginning))))
+
+(defun dired-mark--region-beginning ()
+ "Return the value of the region beginning aligned to Dired file lines."
+ (if (dired-mark--region-use-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (line-beginning-position))
+ (point-min)))
+
+(defun dired-mark--region-end ()
+ "Return the value of the region end aligned to Dired file lines."
+ (if (dired-mark--region-use-p)
+ (save-excursion
+ (goto-char (region-end))
+ (if (if (eq dired-mark-region 'line)
+ (not (bolp))
+ (get-text-property (1- (point)) 'dired-filename))
+ (line-end-position)
+ (line-beginning-position)))
+ (point-max)))
+
;; The dired command
@@ -849,7 +970,6 @@ If a directory or nothing is found at point, return nil."
(if (and file-name
(not (file-directory-p file-name)))
file-name)))
-(put 'dired-mode 'grep-read-files 'dired-grep-read-files)
;;;###autoload (define-key ctl-x-map "d" 'dired)
;;;###autoload
@@ -1149,15 +1269,11 @@ wildcards, erases the buffer, and builds the subdir-alist anew
;; default-directory and dired-actual-switches must be buffer-local
;; and initialized by now.
- (let (dirname
- ;; This makes read-in much faster.
- ;; In particular, it prevents the font lock hook from running
- ;; until the directory is all read in.
- (inhibit-modification-hooks t))
- (if (consp dired-directory)
- (setq dirname (car dired-directory))
- (setq dirname dired-directory))
- (setq dirname (expand-file-name dirname))
+ (let ((dirname
+ (expand-file-name
+ (if (consp dired-directory)
+ (car dired-directory)
+ dired-directory))))
(save-excursion
;; This hook which may want to modify dired-actual-switches
;; based on dired-directory, e.g. with ange-ftp to a SysV host
@@ -1167,17 +1283,25 @@ wildcards, erases the buffer, and builds the subdir-alist anew
(setq buffer-undo-list nil))
(setq-local file-name-coding-system
(or coding-system-for-read file-name-coding-system))
- (let ((inhibit-read-only t)
- ;; Don't make undo entries for readin.
- (buffer-undo-list t))
- (widen)
- (erase-buffer)
- (dired-readin-insert))
- (goto-char (point-min))
- ;; Must first make alist buffer local and set it to nil because
- ;; dired-build-subdir-alist will call dired-clear-alist first
- (setq-local dired-subdir-alist nil)
- (dired-build-subdir-alist)
+ (widen)
+ ;; We used to bind `inhibit-modification-hooks' to try and speed up
+ ;; execution, in particular, to prevent the font-lock hook from running
+ ;; until the directory is all read in.
+ ;; It's not clear why font-lock would be a significant issue
+ ;; here, but I used `combine-change-calls' which should provide the
+ ;; same performance advantages without the problem of breaking
+ ;; users of after/before-change-functions.
+ (combine-change-calls (point-min) (point-max)
+ (let ((inhibit-read-only t)
+ ;; Don't make undo entries for readin.
+ (buffer-undo-list t))
+ (erase-buffer)
+ (dired-readin-insert))
+ (goto-char (point-min))
+ ;; Must first make alist buffer local and set it to nil because
+ ;; dired-build-subdir-alist will call dired-clear-alist first
+ (setq-local dired-subdir-alist nil)
+ (dired-build-subdir-alist))
(let ((attributes (file-attributes dirname)))
(if (eq (car attributes) t)
(set-visited-file-modtime (file-attribute-modification-time
@@ -1380,7 +1504,7 @@ see `dired-use-ls-dired' for more details.")
;; "--dired", so we cannot add it to the `process-file'
;; call for wildcards.
(when (file-remote-p dir)
- (setq switches (dired-replace-in-string "--dired" "" switches)))
+ (setq switches (string-replace "--dired" "" switches)))
(let* ((default-directory (car dir-wildcard))
(script (format "ls %s %s" switches (cdr dir-wildcard)))
(remotep (file-remote-p dir))
@@ -1389,6 +1513,13 @@ see `dired-use-ls-dired' for more details.")
(executable-find explicit-shell-file-name))
(executable-find "sh")))
(switch (if remotep "-c" shell-command-switch)))
+ ;; Enable globstar
+ (when-let ((globstar dired-maybe-use-globstar)
+ (enable-it
+ (assoc-default
+ (file-truename sh) dired-enable-globstar-in-shell
+ (lambda (reg shell) (string-match reg shell)))))
+ (setq script (format "%s; %s" enable-it script)))
(unless
(zerop
(process-file sh nil (current-buffer) nil switch script))
@@ -1811,6 +1942,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(define-key map "\177" 'dired-unmark-backward)
(define-key map [remap undo] 'dired-undo)
(define-key map [remap advertised-undo] 'dired-undo)
+ (define-key map [remap vc-next-action] 'dired-vc-next-action)
;; thumbnail manipulation (image-dired)
(define-key map "\C-td" 'image-dired-display-thumbs)
(define-key map "\C-tt" 'image-dired-tag-files)
@@ -2134,8 +2266,15 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
'(menu-item "Shell Command..." dired-do-shell-command
:help "Run a shell command on current or marked files"))
(define-key map [menu-bar operate delete]
- '(menu-item "Delete" dired-do-delete
- :help "Delete current file or all marked files"))
+ `(menu-item "Delete"
+ ,(let ((menu (make-sparse-keymap "Delete")))
+ (define-key menu [delete-flagged]
+ '(menu-item "Delete Flagged Files" dired-do-flagged-delete
+ :help "Delete all files flagged for deletion (D)"))
+ (define-key menu [delete-marked]
+ '(menu-item "Delete Marked (Not Flagged) Files" dired-do-delete
+ :help "Delete current file or all marked files (excluding flagged files)"))
+ menu)))
(define-key map [menu-bar operate rename]
'(menu-item "Rename to..." dired-do-rename
:help "Rename current file or move marked files"))
@@ -2149,6 +2288,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
;; Dired mode is suitable only for specially formatted data.
(put 'dired-mode 'mode-class 'special)
+(defvar grep-read-files-function)
;; Autoload cookie needed by desktop.el
;;;###autoload
(defun dired-mode (&optional dirname switches)
@@ -2210,7 +2350,6 @@ Hooks (use \\[describe-variable] to see their documentation):
`dired-before-readin-hook'
`dired-after-readin-hook'
`dired-mode-hook'
- `dired-load-hook'
Keybindings:
\\{dired-mode-map}"
@@ -2243,6 +2382,7 @@ Keybindings:
(setq-local font-lock-defaults
'(dired-font-lock-keywords t nil nil beginning-of-line))
(setq-local desktop-save-buffer 'dired-desktop-buffer-misc-data)
+ (setq-local grep-read-files-function #'dired-grep-read-files)
(setq dired-switches-alist nil)
(hack-dir-local-variables-non-file-buffer) ; before sorting
(dired-sort-other dired-actual-switches t)
@@ -2445,6 +2585,21 @@ Otherwise, display it in another buffer."
;;; Functions for extracting and manipulating file names in Dired buffers.
+(defun dired-unhide-subdir ()
+ (with-silent-modifications
+ (dired--unhide (dired-subdir-min) (dired-subdir-max))))
+
+(defun dired-subdir-hidden-p (dir)
+ (save-excursion
+ (dired-goto-subdir dir)
+ (dired--hidden-p)))
+
+(defun dired-subdir-min ()
+ (save-excursion
+ (if (not (dired-prev-subdir 0 t t))
+ (error "Not in a subdir!")
+ (point))))
+
(defun dired-get-filename (&optional localp no-error-if-not-filep)
"In Dired, return name of file mentioned on this line.
Value returned normally includes the directory name.
@@ -2455,10 +2610,17 @@ it occurs in the buffer, and a value of t means construct name relative to
Optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as
regular filenames and return nil if no filename on this line.
Otherwise, an error occurs in these cases."
- (let (case-fold-search file p1 p2 already-absolute)
+ (let ((hidden (and dired-subdir-alist
+ (dired-subdir-hidden-p
+ (dired-current-directory))))
+ case-fold-search file p1 p2 already-absolute)
+ (when hidden
+ (dired-unhide-subdir))
(save-excursion
(if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
(setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
+ (when hidden
+ (dired-hide-subdir 1))
;; nil if no file on this line, but no-error-if-not-filep is t:
(if (setq file (and p1 p2 (buffer-substring p1 p2)))
(progn
@@ -2768,12 +2930,12 @@ You can then feed the file name(s) to other commands with \\[yank]."
;; Keeping Dired buffers in sync with the filesystem and with each other
(defun dired-buffers-for-dir (dir &optional file)
-;; Return a list of buffers for DIR (top level or in-situ subdir).
-;; If FILE is non-nil, include only those whose wildcard pattern (if any)
-;; matches FILE.
-;; The list is in reverse order of buffer creation, most recent last.
-;; As a side effect, killed dired buffers for DIR are removed from
-;; dired-buffers.
+ "Return a list of buffers for DIR (top level or in-situ subdir).
+If FILE is non-nil, include only those whose wildcard pattern (if any)
+matches FILE.
+The list is in reverse order of buffer creation, most recent last.
+As a side effect, killed dired buffers for DIR are removed from
+dired-buffers."
(setq dir (file-name-as-directory dir))
(let (result buf)
(dolist (elt dired-buffers)
@@ -3170,8 +3332,8 @@ Any other value means to ask for each directory."
(const :tag "Confirm for each top directory only" top))
:group 'dired)
-;; Match anything but `.' and `..'.
-(defvar dired-re-no-dot (rx (or (not ".") "...")))
+(define-obsolete-variable-alias 'dired-re-no-dot
+ 'directory-files-no-dot-files-regexp "28.1")
;; Delete file, possibly delete a directory and all its files.
;; This function is useful outside of dired. One could change its name
@@ -3193,7 +3355,9 @@ TRASH non-nil means to trash the file instead of deleting, provided
;; but more efficient
(if (not (eq t (car (file-attributes file))))
(delete-file file trash)
- (let* ((empty-dir-p (null (directory-files file t dired-re-no-dot))))
+ (let* ((empty-dir-p (null (directory-files
+ file t
+ directory-files-no-dot-files-regexp))))
(if (and recursive (not empty-dir-p))
(unless (eq recursive 'always)
(let ((prompt
@@ -3320,18 +3484,28 @@ Return list of buffers where FUN succeeded (i.e., returned non-nil)."
(let (success-list)
(dolist (buf (dired-buffers-for-dir (expand-file-name directory) file))
(with-current-buffer buf
- (if (apply fun args)
- (push buf success-list))))
+ (when (apply fun args)
+ (push (buffer-name buf) success-list))))
;; FIXME: AFAICT, this return value is not used by any of the callers!
success-list))
;; Delete the entry for FILE from
-(defun dired-delete-entry (file)
+(defun dired-remove-entry (file)
+ "Remove entry FILE in the current dired buffer.
+Note this doesn't delete FILE in the file system.
+See `dired-delete-file' in case you wish that."
(save-excursion
(and (dired-goto-file file)
(let ((inhibit-read-only t))
(delete-region (progn (beginning-of-line) (point))
- (save-excursion (forward-line 1) (point))))))
+ (line-beginning-position 2))))))
+
+(defun dired-delete-entry (file)
+ "Remove entry FILE in the current dired buffer.
+Like `dired-remove-entry' followed by `dired-clean-up-after-deletion'.
+Note this doesn't delete FILE in the file system.
+See `dired-delete-file' in case you wish that."
+ (dired-remove-entry file)
(dired-clean-up-after-deletion file))
(defvar dired-clean-up-buffers-too)
@@ -3460,26 +3634,27 @@ argument or confirmation)."
;; Mark *Marked Files* window as softly-dedicated, to prevent
;; other buffers e.g. *Completions* from reusing it (bug#17554).
(display-buffer-mark-dedicated 'soft))
- (with-displayed-buffer-window
+ (with-current-buffer-window
buffer
- (cons 'display-buffer-below-selected
- '((window-height . fit-window-to-buffer)
- (preserve-size . (nil . t))))
+ `(display-buffer-below-selected
+ (window-height . fit-window-to-buffer)
+ (preserve-size . (nil . t))
+ (body-function
+ . ,#'(lambda (_window)
+ ;; Handle (t FILE) just like (FILE), here. That value is
+ ;; used (only in some cases), to mean just one file that was
+ ;; marked, rather than the current line file.
+ (dired-format-columns-of-files
+ (if (eq (car files) t) (cdr files) files))
+ (remove-text-properties (point-min) (point-max)
+ '(mouse-face nil help-echo nil))
+ (setq tab-line-exclude nil))))
#'(lambda (window _value)
(with-selected-window window
(unwind-protect
(apply function args)
(when (window-live-p window)
- (quit-restore-window window 'kill)))))
- ;; Handle (t FILE) just like (FILE), here. That value is
- ;; used (only in some cases), to mean just one file that was
- ;; marked, rather than the current line file.
- (with-current-buffer buffer
- (dired-format-columns-of-files
- (if (eq (car files) t) (cdr files) files))
- (remove-text-properties (point-min) (point-max)
- '(mouse-face nil help-echo nil))
- (setq tab-line-exclude nil))))))
+ (quit-restore-window window 'kill)))))))))
(defun dired-format-columns-of-files (files)
(let ((beg (point)))
@@ -3578,7 +3753,8 @@ no ARGth marked file is found before this line."
(defun dired-mark (arg &optional interactive)
"Mark the file at point in the Dired buffer.
-If the region is active, mark all files in the region.
+If the region is active in Transient Mark mode, mark all files
+in the region if `dired-mark-region' is non-nil.
Otherwise, with a prefix arg, mark files on the next ARG lines.
If on a subdir headerline, mark all its files except `.' and `..'.
@@ -3589,13 +3765,20 @@ this subdir."
(interactive (list current-prefix-arg t))
(cond
;; Mark files in the active region.
- ((and interactive (use-region-p))
+ ((and interactive dired-mark-region
+ (region-active-p)
+ (> (region-end) (region-beginning)))
(save-excursion
(let ((beg (region-beginning))
(end (region-end)))
(dired-mark-files-in-region
(progn (goto-char beg) (line-beginning-position))
- (progn (goto-char end) (line-beginning-position))))))
+ (progn (goto-char end)
+ (if (if (eq dired-mark-region 'line)
+ (not (bolp))
+ (get-text-property (1- (point)) 'dired-filename))
+ (line-end-position)
+ (line-beginning-position)))))))
;; Mark subdir files from the subdir headerline.
((dired-get-subdir)
(save-excursion (dired-mark-subdir-files)))
@@ -3643,12 +3826,18 @@ in the active region."
"Toggle marks: marked files become unmarked, and vice versa.
Flagged files (indicated with flags such as `C' and `D', not
with `*') are not affected, and `.' and `..' are never toggled.
-As always, hidden subdirs are not affected."
+As always, hidden subdirs are not affected.
+
+In Transient Mark mode, if the mark is active, operate on the contents
+of the region if `dired-mark-region' is non-nil. Otherwise, operate
+on the whole buffer."
(interactive)
(save-excursion
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (while (not (eobp))
+ (let ((inhibit-read-only t)
+ (beg (dired-mark--region-beginning))
+ (end (dired-mark--region-end)))
+ (goto-char beg)
+ (while (< (point) end)
(or (dired-between-files)
(looking-at-p dired-re-dot)
;; use subst instead of insdel because it does not move
@@ -3676,6 +3865,9 @@ As always, hidden subdirs are not affected."
A prefix argument means to unmark them instead.
`.' and `..' are never marked.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil.
+
REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for
object files--just `.o' will mark more than you might think."
(interactive
@@ -3727,6 +3919,9 @@ object files--just `.o' will mark more than you might think."
A prefix argument means to unmark them instead.
`.' and `..' are never marked.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil.
+
Note that if a file is visited in an Emacs buffer, and
`dired-always-read-filesystem' is nil, this command will
look in the buffer without revisiting the file, so the results might
@@ -3771,14 +3966,18 @@ The match is against the non-directory part of the filename. Use `^'
(defun dired-mark-symlinks (unflag-p)
"Mark all symbolic links.
-With prefix argument, unmark or unflag all those files."
+With prefix argument, unmark or unflag all those files.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if (looking-at-p dired-re-sym) "symbolic link")))
(defun dired-mark-directories (unflag-p)
"Mark all directory file lines except `.' and `..'.
-With prefix argument, unmark or unflag all those files."
+With prefix argument, unmark or unflag all those files.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if (and (looking-at-p dired-re-dir)
@@ -3787,7 +3986,9 @@ With prefix argument, unmark or unflag all those files."
(defun dired-mark-executables (unflag-p)
"Mark all executable files.
-With prefix argument, unmark or unflag all those files."
+With prefix argument, unmark or unflag all those files.
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if (looking-at-p dired-re-exe) "executable file")))
@@ -3797,7 +3998,9 @@ With prefix argument, unmark or unflag all those files."
(defun dired-flag-auto-save-files (&optional unflag-p)
"Flag for deletion files whose names suggest they are auto save files.
-A prefix argument says to unmark or unflag those files instead."
+A prefix argument says to unmark or unflag those files instead.
+If the region is active in Transient Mark mode, flag files
+only in the active region if `dired-mark-region' is non-nil."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
(dired-mark-if
@@ -3837,7 +4040,9 @@ A prefix argument says to unmark or unflag those files instead."
(defun dired-flag-backup-files (&optional unflag-p)
"Flag all backup files (names ending with `~') for deletion.
-With prefix argument, unmark or unflag these files."
+With prefix argument, unmark or unflag these files.
+If the region is active in Transient Mark mode, flag files
+only in the active region if `dired-mark-region' is non-nil."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
(dired-mark-if
@@ -3860,25 +4065,28 @@ With prefix argument, unmark or unflag these files."
(defun dired-change-marks (&optional old new)
"Change all OLD marks to NEW marks.
OLD and NEW are both characters used to mark files."
+ (declare (advertised-calling-convention (old new) "28.1"))
(interactive
(let* ((cursor-in-echo-area t)
(old (progn (message "Change (old mark): ") (read-char)))
(new (progn (message "Change %c marks to (new mark): " old)
(read-char))))
(list old new)))
- (if (or (eq old ?\r) (eq new ?\r))
- (ding)
- (let ((string (format "\n%c" old))
- (inhibit-read-only t))
- (save-excursion
- (goto-char (point-min))
- (while (search-forward string nil t)
- (if (if (= old ?\s)
- (save-match-data
- (dired-get-filename 'no-dir t))
- t)
- (subst-char-in-region (match-beginning 0)
- (match-end 0) old new)))))))
+ (dolist (c (list new old))
+ (if (or (not (char-displayable-p c))
+ (eq c ?\r))
+ (user-error "Invalid mark character: `%c'" c)))
+ (let ((string (format "\n%c" old))
+ (inhibit-read-only t))
+ (save-excursion
+ (goto-char (point-min))
+ (while (search-forward string nil t)
+ (if (if (= old ?\s)
+ (save-match-data
+ (dired-get-filename 'no-dir t))
+ t)
+ (subst-char-in-region (match-beginning 0)
+ (match-end 0) old new))))))
(defun dired-unmark-all-marks ()
"Remove all marks from all files in the Dired buffer."
@@ -4019,22 +4227,50 @@ format, use `\\[universal-argument] \\[dired]'.")
"Non-nil means the Dired sort command is disabled.
The idea is to set this buffer-locally in special Dired buffers.")
+(defcustom dired-switches-in-mode-line nil
+ "How to indicate `dired-actual-switches' in mode-line.
+Possible values:
+ * `nil': Indicate name-or-date sort order, if possible.
+ Else show full switches.
+ * `as-is': Show full switches.
+ * Integer: Show only the first N chars of full switches.
+ * Function: Pass `dired-actual-switches' as arg and show result."
+ :group 'Dired-Plus
+ :type '(choice
+ (const :tag "Indicate by name or date, else full" nil)
+ (const :tag "Show full switches" as-is)
+ (integer :tag "Show first N chars of switches" :value 10)
+ (function :tag "Format with function" :value identity)))
+
(defun dired-sort-set-mode-line ()
- ;; Set mode line display according to dired-actual-switches.
- ;; Mode line display of "by name" or "by date" guarantees the user a
- ;; match with the corresponding regexps. Non-matching switches are
- ;; shown literally.
+ "Set mode-line according to option `dired-switches-in-mode-line'."
(when (eq major-mode 'dired-mode)
(setq mode-name
- (let (case-fold-search)
- (cond ((string-match-p
- dired-sort-by-name-regexp dired-actual-switches)
- "Dired by name")
- ((string-match-p
- dired-sort-by-date-regexp dired-actual-switches)
- "Dired by date")
- (t
- (concat "Dired " dired-actual-switches)))))
+ (let ((case-fold-search nil))
+ (if dired-switches-in-mode-line
+ (concat
+ "Dired"
+ (cond ((integerp dired-switches-in-mode-line)
+ (let* ((l1 (length dired-actual-switches))
+ (xs (substring
+ dired-actual-switches
+ 0 (min l1 dired-switches-in-mode-line)))
+ (l2 (length xs)))
+ (if (zerop l2)
+ xs
+ (concat " " xs (and (< l2 l1) "…")))))
+ ((functionp dired-switches-in-mode-line)
+ (format " %s" (funcall
+ dired-switches-in-mode-line
+ dired-actual-switches)))
+ (t (concat " " dired-actual-switches))))
+ (cond ((string-match-p dired-sort-by-name-regexp
+ dired-actual-switches)
+ "Dired by name")
+ ((string-match-p dired-sort-by-date-regexp
+ dired-actual-switches)
+ "Dired by date")
+ (t (concat "Dired " dired-actual-switches))))))
(force-mode-line-update)))
(define-obsolete-function-alias 'dired-sort-set-modeline
@@ -4082,11 +4318,10 @@ With a prefix argument, edit the current listing switches instead."
(dired-sort-set-mode-line)
(revert-buffer))
-;; Some user code loads dired especially for this.
-;; Don't do that--use replace-regexp-in-string instead.
(defun dired-replace-in-string (regexp newtext string)
;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
+ (declare (obsolete replace-regexp-in-string "28.1"))
(let ((result "") (start 0) mb me)
(while (string-match regexp string start)
(setq mb (match-beginning 0)
@@ -4289,6 +4524,70 @@ Ask means pop up a menu for the user to select one of copy, move or link."
(add-to-list 'desktop-buffer-mode-handlers
'(dired-mode . dired-restore-desktop-buffer))
+
+;;;; Jump to Dired
+
+(defvar archive-superior-buffer)
+(defvar tar-superior-buffer)
+
+;;;###autoload
+(defun dired-jump (&optional other-window file-name)
+ "Jump to Dired buffer corresponding to current buffer.
+If in a file, Dired the current directory and move to file's line.
+If in Dired already, pop up a level and goto old directory's line.
+In case the proper Dired file line cannot be found, refresh the dired
+buffer and try again.
+When OTHER-WINDOW is non-nil, jump to Dired buffer in other window.
+When FILE-NAME is non-nil, jump to its line in Dired.
+Interactively with prefix argument, read FILE-NAME."
+ (interactive
+ (list nil (and current-prefix-arg
+ (read-file-name "Jump to Dired file: "))))
+ (cond
+ ((and (bound-and-true-p archive-subfile-mode)
+ (buffer-live-p archive-superior-buffer))
+ (switch-to-buffer archive-superior-buffer))
+ ((and (bound-and-true-p tar-subfile-mode)
+ (buffer-live-p tar-superior-buffer))
+ (switch-to-buffer tar-superior-buffer))
+ (t
+ ;; Expand file-name before `dired-goto-file' call:
+ ;; `dired-goto-file' requires its argument to be an absolute
+ ;; file name; the result of `read-file-name' could be
+ ;; an abbreviated file name (Bug#24409).
+ (let* ((file (or (and file-name (expand-file-name file-name))
+ buffer-file-name))
+ (dir (if file (file-name-directory file) default-directory)))
+ (if (and (eq major-mode 'dired-mode) (null file-name))
+ (progn
+ (setq dir (dired-current-directory))
+ (dired-up-directory other-window)
+ (unless (dired-goto-file dir)
+ ;; refresh and try again
+ (dired-insert-subdir (file-name-directory dir))
+ (dired-goto-file dir)))
+ (if other-window
+ (dired-other-window dir)
+ (dired dir))
+ (if file
+ (or (dired-goto-file file)
+ ;; refresh and try again
+ (progn
+ (dired-insert-subdir (file-name-directory file))
+ (dired-goto-file file))
+ ;; Toggle omitting, if it is on, and try again.
+ (when (bound-and-true-p dired-omit-mode)
+ (dired-omit-mode)
+ (dired-goto-file file)))))))))
+
+;;;###autoload
+(defun dired-jump-other-window (&optional file-name)
+ "Like \\[dired-jump] (`dired-jump') but in other window."
+ (interactive
+ (list (and current-prefix-arg
+ (read-file-name "Jump to Dired file: "))))
+ (dired-jump t file-name))
+
(provide 'dired)
(run-hooks 'dired-load-hook) ; for your customizations
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index 3a0bbd2c9c2..ad0c18d1b38 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -196,9 +196,6 @@ directory."
(remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
-(define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode
- "23.1")
-(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1")
(define-minor-mode dirtrack-debug-mode
"Toggle Dirtrack debugging."
nil nil nil
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index fe63573c0a3..70343a39ad2 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -220,8 +220,6 @@ for a graphical frame."
;;;###autoload
(defun make-glyph-code (char &optional face)
"Return a glyph code representing char CHAR with face FACE."
- ;; Due to limitations on Emacs integer values, faces with
- ;; face id greater that 512 are silently ignored.
(if (not face)
char
(let ((fid (face-id face)))
diff --git a/lisp/display-fill-column-indicator.el b/lisp/display-fill-column-indicator.el
index 2013fb13abd..5fd9f07cd46 100644
--- a/lisp/display-fill-column-indicator.el
+++ b/lisp/display-fill-column-indicator.el
@@ -59,12 +59,13 @@ See Info node `Displaying Boundaries' for details."
(progn
(setq display-fill-column-indicator t)
(unless display-fill-column-indicator-character
- (if (and (char-displayable-p ?\u2502)
- (or (not (display-graphic-p))
- (eq (aref (query-font (car (internal-char-font nil ?\u2502))) 0)
- (face-font 'default))))
- (setq display-fill-column-indicator-character ?\u2502)
- (setq display-fill-column-indicator-character ?|))))
+ (setq display-fill-column-indicator-character
+ (if (and (char-displayable-p ?\u2502)
+ (or (not (display-graphic-p))
+ (eq (aref (query-font (car (internal-char-font nil ?\u2502))) 0)
+ (face-font 'default))))
+ ?\u2502
+ ?|))))
(setq display-fill-column-indicator nil)))
(defun display-fill-column-indicator--turn-on ()
@@ -76,8 +77,7 @@ See Info node `Displaying Boundaries' for details."
;;;###autoload
(define-globalized-minor-mode global-display-fill-column-indicator-mode
display-fill-column-indicator-mode display-fill-column-indicator--turn-on
- ;; See bug#41145
- :group 'display-fill-column-indicator)
+ :predicate '((not special-mode) t))
(provide 'display-fill-column-indicator)
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 905659e817b..815a4afbecd 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -1,4 +1,4 @@
-;;; dnd.el --- drag and drop support
+;;; dnd.el --- drag and drop support -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
@@ -33,6 +33,9 @@
;;; Customizable variables
+(defgroup dnd nil
+ "Handling data from drag and drop."
+ :group 'environment)
;;;###autoload
(defcustom dnd-protocol-alist
@@ -54,14 +57,13 @@ If no match is found, the URL is inserted as text by calling `dnd-insert-text'.
The function shall return the action done (move, copy, link or private)
if some action was made, or nil if the URL is ignored."
:version "22.1"
- :type '(repeat (cons (regexp) (function)))
- :group 'dnd)
+ :type '(repeat (cons (regexp) (function))))
(defcustom dnd-open-remote-file-function
(if (eq system-type 'windows-nt)
- 'dnd-open-local-file
- 'dnd-open-remote-url)
+ #'dnd-open-local-file
+ #'dnd-open-remote-url)
"The function to call when opening a file on a remote machine.
The function will be called with two arguments, URI and ACTION.
See `dnd-open-file' for details.
@@ -71,15 +73,13 @@ Predefined functions are `dnd-open-local-file' and `dnd-open-remote-url'.
is the default on MS-Windows. `dnd-open-remote-url' uses `url-handler-mode'
and is the default except for MS-Windows."
:version "22.1"
- :type 'function
- :group 'dnd)
+ :type 'function)
(defcustom dnd-open-file-other-window nil
"If non-nil, always use find-file-other-window to open dropped files."
:version "22.1"
- :type 'boolean
- :group 'dnd)
+ :type 'boolean)
;; Functions
@@ -87,13 +87,11 @@ and is the default except for MS-Windows."
(defun dnd-handle-one-url (window action url)
"Handle one dropped url by calling the appropriate handler.
The handler is first located by looking at `dnd-protocol-alist'.
-If no match is found here, and the value of `browse-url-browser-function'
-is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
-If no match is found, just call `dnd-insert-text'.
-WINDOW is where the drop happened, ACTION is the action for the drop,
-URL is what has been dropped.
-Returns ACTION."
- (require 'browse-url)
+If no match is found here, `browse-url-handlers' and
+`browse-url-default-handlers' are searched for a match.
+If no match is found, just call `dnd-insert-text'. WINDOW is
+where the drop happened, ACTION is the action for the drop, URL
+is what has been dropped. Returns ACTION."
(let (ret)
(or
(catch 'done
@@ -102,14 +100,13 @@ Returns ACTION."
(setq ret (funcall (cdr bf) url action))
(throw 'done t)))
nil)
- (when (not (functionp browse-url-browser-function))
- (catch 'done
- (dolist (bf browse-url-browser-function)
- (when (string-match (car bf) url)
- (setq ret 'private)
- (funcall (cdr bf) url action)
- (throw 'done t)))
- nil))
+ (catch 'done
+ (let ((browser (browse-url-select-handler url 'internal)))
+ (when browser
+ (setq ret 'private)
+ (funcall browser url action)
+ (throw 'done t)))
+ nil)
(progn
(dnd-insert-text window action url)
(setq ret 'private)))
@@ -136,7 +133,8 @@ Return nil if URI is not a local file."
(string-equal sysname-no-dot hostname)))
(concat "file://" (substring uri (+ 7 (length hostname))))))))
-(defsubst dnd-unescape-uri (uri)
+(defun dnd--unescape-uri (uri)
+ ;; Merge with corresponding code in URL library.
(replace-regexp-in-string
"%[[:xdigit:]][[:xdigit:]]"
(lambda (arg)
@@ -160,7 +158,7 @@ Return nil if URI is not a local file."
'utf-8
(or file-name-coding-system
default-file-name-coding-system))))
- (and f (setq f (decode-coding-string (dnd-unescape-uri f) coding)))
+ (and f (setq f (decode-coding-string (dnd--unescape-uri f) coding)))
(when (and f must-exist (not (file-readable-p f)))
(setq f nil))
f))
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index b895377f8dc..9997c1ae7b8 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -24,8 +24,8 @@
;; Viewing PS/PDF/DVI files requires Ghostscript, `dvipdf' (comes with
;; Ghostscript) or `dvipdfm' (comes with teTeX or TeXLive) and
-;; `pdftotext', which comes with xpdf (http://www.foolabs.com/xpdf/)
-;; or poppler (http://poppler.freedesktop.org/).
+;; `pdftotext', which comes with xpdf (https://www.foolabs.com/xpdf/)
+;; or poppler (https://poppler.freedesktop.org/).
;; Djvu documents require `ddjvu' (from DjVuLibre).
;; ODF files require `soffice' (from LibreOffice).
@@ -438,6 +438,9 @@ Typically \"page-%s.png\".")
(define-key map (kbd "c m") 'doc-view-set-slice-using-mouse)
(define-key map (kbd "c b") 'doc-view-set-slice-from-bounding-box)
(define-key map (kbd "c r") 'doc-view-reset-slice)
+ ;; Centering the image
+ (define-key map (kbd "c h") 'doc-view-center-page-horizontally)
+ (define-key map (kbd "c v") 'doc-view-center-page-vertically)
;; Searching
(define-key map (kbd "C-s") 'doc-view-search)
(define-key map (kbd "<find>") 'doc-view-search)
@@ -696,8 +699,6 @@ at the top edge of the page moves to the previous page."
;; time-window of loose permissions otherwise.
(with-file-modes #o0700 (make-directory dir))
(file-already-exists
- (when (file-symlink-p dir)
- (error "Danger: %s points to a symbolic link" dir))
;; In case it was created earlier with looser rights.
;; We could check the mode info returned by file-attributes, but it's
;; a pain to parse and it may not tell you what we want under
@@ -707,7 +708,7 @@ at the top edge of the page moves to the previous page."
;; sure we have write-access to the directory and that we own it, thus
;; closing a bunch of security holes.
(condition-case error
- (set-file-modes dir #o0700)
+ (set-file-modes dir #o0700 'nofollow)
(file-error
(error
(format "Unable to use temporary directory %s: %s"
@@ -745,8 +746,7 @@ It's a subdirectory of `doc-view-cache-directory'."
Document types are symbols like `dvi', `ps', `pdf', or `odf' (any
OpenDocument format)."
(and (display-graphic-p)
- (or (image-type-available-p 'imagemagick)
- (image-type-available-p 'png))
+ (image-type-available-p 'png)
(cond
((eq type 'dvi)
(and (doc-view-mode-p 'pdf)
@@ -774,10 +774,7 @@ OpenDocument format)."
(defun doc-view-enlarge (factor)
"Enlarge the document by FACTOR."
(interactive (list doc-view-shrink-factor))
- (if (and doc-view-scale-internally
- (eq (plist-get (cdr (doc-view-current-image)) :type)
- 'imagemagick))
- ;; ImageMagick supports on-the-fly-rescaling.
+ (if doc-view-scale-internally
(let ((new (ceiling (* factor doc-view-image-width))))
(unless (equal new doc-view-image-width)
(setq-local doc-view-image-width new)
@@ -797,9 +794,7 @@ OpenDocument format)."
(defun doc-view-scale-reset ()
"Reset the document size/zoom level to the initial one."
(interactive)
- (if (and doc-view-scale-internally
- (eq (plist-get (cdr (doc-view-current-image)) :type)
- 'imagemagick))
+ (if doc-view-scale-internally
(progn
(kill-local-variable 'doc-view-image-width)
(doc-view-insert-image
@@ -918,20 +913,56 @@ Resize the containing frame if needed."
(width-diff (- img-width win-width))
(height-diff (- img-height win-height))
(new-frame-params
+ ;; If we can't resize the window, try and resize the frame.
+ ;; We used to compare the `window-width/height` and the
+ ;; `frame-width/height` instead of catching the errors, but
+ ;; it's too fiddly (e.g. in the presence of the miniwindow,
+ ;; the height the frame should be equal to the height of the
+ ;; root window +1).
(append
- (if (= (window-width) (frame-width))
- `((width . (text-pixels
- . ,(+ (frame-text-width) width-diff))))
- (enlarge-window (/ width-diff (frame-char-width)) 'horiz)
- nil)
- (if (= (window-height) (frame-height))
- `((height . (text-pixels
- . ,(+ (frame-text-height) height-diff))))
- (enlarge-window (/ height-diff (frame-char-height)) nil)
- nil))))
+ (condition-case nil
+ (progn
+ (enlarge-window (/ width-diff (frame-char-width)) 'horiz)
+ nil)
+ (error
+ `((width . (text-pixels
+ . ,(+ (frame-text-width) width-diff))))))
+ (condition-case nil
+ (progn
+ (enlarge-window (/ height-diff (frame-char-height)) nil)
+ nil)
+ (error
+ `((height . (text-pixels
+ . ,(+ (frame-text-height) height-diff)))))))))
(when new-frame-params
(modify-frame-parameters (selected-frame) new-frame-params))))
+(defun doc-view-center-page-horizontally ()
+ "Center page horizontally when page is wider than window."
+ (interactive)
+ (let ((page-width (car (image-size (doc-view-current-image) 'pixel)))
+ (window-width (window-body-width nil 'pixel))
+ ;; How much do we scroll in order to center the page?
+ (pixel-hscroll 0)
+ ;; How many pixels are there in a column?
+ (col-in-pixel (/ (window-body-width nil 'pixel)
+ (window-body-width nil))))
+ (when (> page-width window-width)
+ (setq pixel-hscroll (/ (- page-width window-width) 2))
+ (set-window-hscroll (selected-window)
+ (/ pixel-hscroll col-in-pixel)))))
+
+(defun doc-view-center-page-vertically ()
+ "Center page vertically when page is wider than window."
+ (interactive)
+ (let ((page-height (cdr (image-size (doc-view-current-image) 'pixel)))
+ (window-height (window-body-height nil 'pixel))
+ ;; How much do we scroll in order to center the page?
+ (pixel-scroll 0))
+ (when (> page-height window-height)
+ (setq pixel-scroll (/ (- page-height window-height) 2))
+ (set-window-vscroll (selected-window) pixel-scroll 'pixel))))
+
(defun doc-view-reconvert-doc ()
"Reconvert the current document.
Should be invoked when the cached images aren't up-to-date."
@@ -1302,26 +1333,31 @@ dragging it to its bottom-right corner. See also
(defun doc-view-get-bounding-box ()
"Get the BoundingBox information of the current page."
- (let* ((page (doc-view-current-page))
- (doc (let ((cache-doc (doc-view-current-cache-doc-pdf)))
- (if (file-exists-p cache-doc)
- cache-doc
- doc-view--buffer-file-name)))
- (o (shell-command-to-string
- (concat doc-view-ghostscript-program
- " -dSAFER -dBATCH -dNOPAUSE -q -sDEVICE=bbox "
- (format "-dFirstPage=%s -dLastPage=%s %s"
- page page doc)))))
- (save-match-data
- (when (string-match (concat "%%BoundingBox: "
- "\\([[:digit:]]+\\) \\([[:digit:]]+\\) "
- "\\([[:digit:]]+\\) \\([[:digit:]]+\\)")
- o)
- (mapcar #'string-to-number
- (list (match-string 1 o)
- (match-string 2 o)
- (match-string 3 o)
- (match-string 4 o)))))))
+ (let ((page (doc-view-current-page))
+ (doc (let ((cache-doc (doc-view-current-cache-doc-pdf)))
+ (if (file-exists-p cache-doc)
+ cache-doc
+ doc-view--buffer-file-name))))
+ (with-temp-buffer
+ (when (eq 0 (ignore-errors
+ (process-file doc-view-ghostscript-program nil t
+ nil "-dSAFER" "-dBATCH" "-dNOPAUSE" "-q"
+ "-sDEVICE=bbox"
+ (format "-dFirstPage=%s" page)
+ (format "-dLastPage=%s" page)
+ doc)))
+ (goto-char (point-min))
+ (save-match-data
+ (when (re-search-forward
+ (concat "%%BoundingBox: "
+ "\\([[:digit:]]+\\) \\([[:digit:]]+\\) "
+ "\\([[:digit:]]+\\) \\([[:digit:]]+\\)")
+ nil t)
+ (mapcar #'string-to-number
+ (list (match-string 1)
+ (match-string 2)
+ (match-string 3)
+ (match-string 4)))))))))
(defvar doc-view-paper-sizes
'((a4 595 842)
@@ -1398,12 +1434,11 @@ ARGS is a list of image descriptors."
;; Only insert the image if the buffer is visible.
(when (window-live-p (overlay-get ol 'window))
(let* ((image (if (and file (file-readable-p file))
- (if (not (and doc-view-scale-internally
- (fboundp 'imagemagick-types)))
+ (if (not doc-view-scale-internally)
(apply #'create-image file doc-view--image-type nil args)
(unless (member :width args)
(setq args `(,@args :width ,doc-view-image-width)))
- (apply #'create-image file 'imagemagick nil args))))
+ (apply #'create-image file doc-view--image-type nil args))))
(slice (doc-view-current-slice))
(img-width (and image (car (image-size image))))
(displayed-img-width (if (and image slice)
@@ -2055,8 +2090,8 @@ See the command `doc-view-mode' for more information on this mode."
(when (memq (selected-frame) (alist-get 'frames attrs))
(let ((geom (alist-get 'geometry attrs)))
(when geom
- (setq monitor-top (nth 0 geom))
- (setq monitor-left (nth 1 geom))
+ (setq monitor-left (nth 0 geom))
+ (setq monitor-top (nth 1 geom))
(setq monitor-width (nth 2 geom))
(setq monitor-height (nth 3 geom))))))
(let ((frame (make-frame
diff --git a/lisp/dom.el b/lisp/dom.el
index 34df0e9af4c..bf4a56ab9f5 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -67,6 +67,12 @@
(setcdr old value)
(setcar (cdr node) (nconc (cadr node) (list (cons attribute value)))))))
+(defun dom-remove-attribute (node attribute)
+ "Remove ATTRIBUTE from NODE."
+ (setq node (dom-ensure-node node))
+ (when-let ((old (assoc attribute (cadr node))))
+ (setcar (cdr node) (delq old (cadr node)))))
+
(defmacro dom-attr (node attr)
"Return the attribute ATTR from NODE.
A typical attribute is `href'."
@@ -263,6 +269,50 @@ white-space."
(insert ")")
(insert "\n" (make-string (1+ column) ? ))))))))
+(defun dom-print (dom &optional pretty xml)
+ "Print DOM at point as HTML/XML.
+If PRETTY, indent the HTML/XML logically.
+If XML, generate XML instead of HTML."
+ (let ((column (current-column)))
+ (insert (format "<%s" (dom-tag dom)))
+ (let ((attr (dom-attributes dom)))
+ (dolist (elem attr)
+ ;; In HTML, these are boolean attributes that should not have
+ ;; an = value.
+ (if (and (memq (car elem)
+ '(async autofocus autoplay checked
+ contenteditable controls default
+ defer disabled formNoValidate frameborder
+ hidden ismap itemscope loop
+ multiple muted nomodule novalidate open
+ readonly required reversed
+ scoped selected typemustmatch))
+ (cdr elem)
+ (not xml))
+ (insert (format " %s" (car elem)))
+ (insert (format " %s=%S" (car elem) (cdr elem))))))
+ (let* ((children (dom-children dom))
+ (non-text nil))
+ (if (null children)
+ (insert " />")
+ (insert ">")
+ (dolist (child children)
+ (if (stringp child)
+ (insert child)
+ (setq non-text t)
+ (when pretty
+ (insert "\n" (make-string (+ column 2) ? )))
+ (dom-print child pretty xml)))
+ ;; If we inserted non-text child nodes, or a text node that
+ ;; ends with a newline, then we indent the end tag.
+ (when (and pretty
+ (or (bolp)
+ non-text))
+ (unless (bolp)
+ (insert "\n"))
+ (insert (make-string column ? )))
+ (insert (format "</%s>" (dom-tag dom)))))))
+
(provide 'dom)
;;; dom.el ends here
diff --git a/lisp/dos-vars.el b/lisp/dos-vars.el
index 0f58277fe51..47d1f83de9e 100644
--- a/lisp/dos-vars.el
+++ b/lisp/dos-vars.el
@@ -1,4 +1,4 @@
-;;; dos-vars.el --- MS-Dos specific user options
+;;; dos-vars.el --- MS-Dos specific user options -*- lexical-binding:t -*-
;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
@@ -31,15 +31,13 @@
(defcustom msdos-shells '("command.com" "4dos.com" "ndos.com")
"List of shells that use `/c' instead of `-c' and a backslashed command."
- :type '(repeat string)
- :group 'dos-fns)
+ :type '(repeat string))
(defcustom dos-codepage-setup-hook nil
"List of functions to be called after the DOS terminal and coding
systems are set up. This is the place, e.g., to set specific entries
in `standard-display-table' as appropriate for your codepage, if
`IT-display-table-setup' doesn't do a perfect job."
- :group 'dos-fns
:type '(hook)
:version "20.3.3")
diff --git a/lisp/double.el b/lisp/double.el
index 639d041a1dc..8e5090034cf 100644
--- a/lisp/double.el
+++ b/lisp/double.el
@@ -99,7 +99,7 @@ but not `C-u X' or `ESC X' since the X is not the prefix key."
(load-library "isearch"))
(define-key isearch-mode-map [ignore]
- (function (lambda () (interactive) (isearch-update))))
+ (lambda () (interactive) (isearch-update)))
(defun double-translate-key (prompt)
;; Translate input events using double map.
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 71474c0289a..1d9b4726b04 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -3,7 +3,6 @@
;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.01
;; Keywords: abbrev
;; This file is part of GNU Emacs.
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index ad39116c680..7da9aed075b 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -31,7 +31,6 @@
;; buffer.
;; To make this the default, you must do
-;; (require 'ehelp)
;; (define-key global-map "\C-h" 'ehelp-command)
;; (define-key global-map [help] 'ehelp-command)
;; (define-key global-map [f1] 'ehelp-command)
@@ -219,7 +218,7 @@ BUFFER is put back into its original major mode."
'electric-help-retain))))
(Electric-command-loop
'exit
- (function (lambda ()
+ (lambda ()
(sit-for 0) ;necessary if last command was end-of-buffer or
;beginning-of-buffer - otherwise pos-visible-in-window-p
;will yield a wrong result.
@@ -241,7 +240,7 @@ BUFFER is put back into its original major mode."
(t
(cond (standard "Press SPC to scroll, DEL to scroll back, q to exit, r to retain ")
(both)
- (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))))))
+ (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain "))))))))
t))))
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 57940456660..a892754d723 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -1,4 +1,4 @@
-;;; elide-head.el --- hide headers in files
+;;; elide-head.el --- hide headers in files -*- lexical-binding: t; -*-
;; Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
@@ -63,12 +63,10 @@ The cars of elements of the list are searched for in order. Text is
elided with an invisible overlay from the end of the line where the
first match is found to the end of the match for the corresponding
cdr."
- :group 'elide-head
- :type '(alist :key-type (string :tag "Start regexp")
- :value-type (string :tag "End regexp")))
+ :type '(alist :key-type (regexp :tag "Start regexp")
+ :value-type (regexp :tag "End regexp")))
-(defvar elide-head-overlay nil)
-(make-variable-buffer-local 'elide-head-overlay)
+(defvar-local elide-head-overlay nil)
;;;###autoload
(defun elide-head (&optional arg)
@@ -108,7 +106,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks."
(overlay-put elide-head-overlay 'after-string "...")))))))
(defun elide-head-show ()
- "Show a header elided current buffer by \\[elide-head]."
+ "Show a header in the current buffer elided by \\[elide-head]."
(interactive)
(if (and (overlayp elide-head-overlay)
(overlay-buffer elide-head-overlay))
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index deac45892ea..5cda399b5ef 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1856,7 +1856,7 @@ function at point for which PREDICATE returns non-nil)."
"There are no qualifying advised functions")))
(let* ((function
(completing-read
- (format "%s (default %s): " (or prompt "Function") default)
+ (format-prompt (or prompt "Function") default)
ad-advised-functions
(if predicate
(lambda (function)
@@ -1884,7 +1884,7 @@ class of FUNCTION)."
(cl-return class)))
(error "ad-read-advice-class: `%s' has no advices" function)))
(let ((class (completing-read
- (format "%s (default %s): " (or prompt "Class") default)
+ (format-prompt (or prompt "Class") default)
ad-advice-class-completion-table nil t)))
(if (equal class "")
default
@@ -1894,16 +1894,16 @@ class of FUNCTION)."
"Read name of existing advice of CLASS for FUNCTION with completion.
An optional PROMPT is used to prompt for the name."
(let* ((name-completion-table
- (mapcar (function (lambda (advice)
- (list (symbol-name (ad-advice-name advice)))))
+ (mapcar (lambda (advice)
+ (list (symbol-name (ad-advice-name advice))))
(ad-get-advice-info-field function class)))
(default
(if (null name-completion-table)
(error "ad-read-advice-name: `%s' has no %s advice"
function class)
(car (car name-completion-table))))
- (prompt (format "%s (default %s): " (or prompt "Name") default))
- (name (completing-read prompt name-completion-table nil t)))
+ (name (completing-read (format-prompt (or prompt "Name") default)
+ name-completion-table nil t)))
(if (equal name "")
(intern default)
(intern name))))
@@ -1923,9 +1923,9 @@ be used to prompt for the function."
(defun ad-read-regexp (&optional prompt)
"Read a regular expression from the minibuffer."
(let ((regexp (read-from-minibuffer
- (concat (or prompt "Regular expression")
- (if (equal ad-last-regexp "") ": "
- (format " (default %s): " ad-last-regexp))))))
+ (format-prompt (or prompt "Regular expression")
+ (and (not (equal ad-last-regexp ""))
+ ad-last-regexp)))))
(setq ad-last-regexp
(if (equal regexp "") ad-last-regexp regexp))))
@@ -2255,13 +2255,11 @@ element is its actual current value, and the third element is either
(let* ((parsed-arglist (ad-parse-arglist arglist))
(rest (nth 2 parsed-arglist)))
`(list
- ,@(mapcar (function
- (lambda (req)
- `(list ',req ,req 'required)))
+ ,@(mapcar (lambda (req)
+ `(list ',req ,req 'required))
(nth 0 parsed-arglist))
- ,@(mapcar (function
- (lambda (opt)
- `(list ',opt ,opt 'optional)))
+ ,@(mapcar (lambda (opt)
+ `(list ',opt ,opt 'optional))
(nth 1 parsed-arglist))
,@(if rest (list `(list ',rest ,rest 'rest))))))
@@ -2623,8 +2621,8 @@ should be modified. The assembled function will be returned."
(defun ad-make-hook-form (function hook-name)
"Make hook-form from FUNCTION's advice bodies in class HOOK-NAME."
(let ((hook-forms
- (mapcar (function (lambda (advice)
- (ad-body-forms (ad-advice-definition advice))))
+ (mapcar (lambda (advice)
+ (ad-body-forms (ad-advice-definition advice)))
(ad-get-enabled-advices function hook-name))))
(if hook-forms
(macroexp-progn (apply 'append hook-forms)))))
@@ -3167,15 +3165,14 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
(setq args (cdr args)))))
(flags
(mapcar
- (function
- (lambda (flag)
+ (lambda (flag)
(let ((completion
(try-completion (symbol-name flag) ad-defadvice-flags)))
(cond ((eq completion t) flag)
((member completion ad-defadvice-flags)
(intern completion))
(t (error "defadvice: Invalid or ambiguous flag: %s"
- flag))))))
+ flag)))))
args))
(advice (ad-make-advice
name (memq 'protect flags)
@@ -3217,11 +3214,10 @@ undone on exit of this macro."
(let* ((index -1)
;; Make let-variables to store current definitions:
(current-bindings
- (mapcar (function
- (lambda (function)
+ (mapcar (lambda (function)
(setq index (1+ index))
(list (intern (format "ad-oRiGdEf-%d" index))
- `(symbol-function ',function))))
+ `(symbol-function ',function)))
functions)))
`(let ,current-bindings
(unwind-protect
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index dc7461d93ee..07bda537b39 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -1,4 +1,4 @@
-;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
+;;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
;; Copyright (C) 1991-1997, 2001-2020 Free Software Foundation, Inc.
@@ -254,12 +254,12 @@ expression, in which case we want to handle forms differently."
;; the doc-string in FORM.
;; Those properties are now set in lisp-mode.el.
-(defun autoload-find-generated-file ()
+(defun autoload-find-generated-file (file)
"Visit the autoload file for the current buffer, and return its buffer."
(let ((enable-local-variables :safe)
(enable-local-eval nil)
- (delay-mode-hooks t)
- (file (autoload-generated-file)))
+ (find-file-hook nil)
+ (delay-mode-hooks t))
;; We used to use `raw-text' to read this file, but this causes
;; problems when the file contains non-ASCII characters.
(with-current-buffer (find-file-noselect
@@ -267,18 +267,20 @@ expression, in which case we want to handle forms differently."
(if (zerop (buffer-size)) (insert (autoload-rubric file nil t)))
(current-buffer))))
-(defun autoload-generated-file ()
- "Return `generated-autoload-file' as an absolute name.
-If local to the current buffer, expand using the default directory;
-otherwise, using `source-directory'/lisp."
- (expand-file-name generated-autoload-file
+(defun autoload-generated-file (outfile)
+ "Return OUTFILE as an absolute name.
+If `generated-autoload-file' is bound locally in the current
+buffer, that is used instead, and it is expanded using the
+default directory; otherwise, `source-directory'/lisp is used."
+ (expand-file-name (if (local-variable-p 'generated-autoload-file)
+ generated-autoload-file
+ outfile)
;; File-local settings of generated-autoload-file should
;; be interpreted relative to the file's location,
;; of course.
(if (not (local-variable-p 'generated-autoload-file))
(expand-file-name "lisp" source-directory))))
-
(defun autoload-read-section-header ()
"Read a section header form.
Since continuation lines have been marked as comments,
@@ -453,13 +455,12 @@ which lists the file name and which functions are in it, etc."
(defvar no-update-autoloads nil
"File local variable to prevent scanning this file for autoload cookies.")
-(defun autoload-file-load-name (file)
+(defun autoload-file-load-name (file outfile)
"Compute the name that will be used to load FILE."
;; OUTFILE should be the name of the global loaddefs.el file, which
;; is expected to be at the root directory of the files we're
;; scanning for autoloads and will be in the `load-path'.
- (let* ((outfile (default-value 'generated-autoload-file))
- (name (file-relative-name file (file-name-directory outfile)))
+ (let* ((name (file-relative-name file (file-name-directory outfile)))
(names '())
(dir (file-name-directory outfile)))
;; If `name' has directory components, only keep the
@@ -489,8 +490,9 @@ If FILE is being visited in a buffer, the contents of the buffer
are used.
Return non-nil in the case where no autoloads were added at point."
(interactive "fGenerate autoloads for file: ")
- (let ((generated-autoload-file buffer-file-name))
- (autoload-generate-file-autoloads file (current-buffer))))
+ (let ((autoload-modified-buffers nil))
+ (autoload-generate-file-autoloads file (current-buffer) buffer-file-name)
+ autoload-modified-buffers))
(defvar autoload-compute-prefixes t
"If non-nil, autoload will add code to register the prefixes used in a file.
@@ -604,11 +606,10 @@ Don't try to split prefixes that are already longer than that.")
prefix file dropped)
nil))))
prefixes)))
- `(if (fboundp 'register-definition-prefixes)
- (register-definition-prefixes ,file ',(sort (delq nil strings)
- 'string<)))))))
+ `(register-definition-prefixes ,file ',(sort (delq nil strings)
+ 'string<))))))
-(defun autoload--setup-output (otherbuf outbuf absfile load-name)
+(defun autoload--setup-output (otherbuf outbuf absfile load-name output-file)
(let ((outbuf
(or (if otherbuf
;; A file-local setting of
@@ -616,7 +617,7 @@ Don't try to split prefixes that are already longer than that.")
;; should ignore OUTBUF.
nil
outbuf)
- (autoload-find-destination absfile load-name)
+ (autoload-find-destination absfile load-name output-file)
;; The file has autoload cookies, but they're
;; already up-to-date. If OUTFILE is nil, the
;; entries are in the expected OUTBUF,
@@ -673,23 +674,16 @@ Don't try to split prefixes that are already longer than that.")
More specifically those definitions will not be considered for the
`register-definition-prefixes' call.")
-;; When called from `generate-file-autoloads' we should ignore
-;; `generated-autoload-file' altogether. When called from
-;; `update-file-autoloads' we don't know `outbuf'. And when called from
-;; `update-directory-autoloads' it's in between: we know the default
-;; `outbuf' but we should obey any file-local setting of
-;; `generated-autoload-file'.
(defun autoload-generate-file-autoloads (file &optional outbuf outfile)
"Insert an autoload section for FILE in the appropriate buffer.
Autoloads are generated for defuns and defmacros in FILE
marked by `generate-autoload-cookie' (which see).
+
If FILE is being visited in a buffer, the contents of the buffer are used.
OUTBUF is the buffer in which the autoload statements should be inserted.
-If OUTBUF is nil, it will be determined by `autoload-generated-file'.
-If provided, OUTFILE is expected to be the file name of OUTBUF.
-If OUTFILE is non-nil and FILE specifies a `generated-autoload-file'
-different from OUTFILE, then OUTBUF is ignored.
+If OUTBUF is nil, the output will go to OUTFILE, unless there's a
+buffer-local setting of `generated-autoload-file' in FILE.
Return non-nil if and only if FILE adds no autoloads to OUTFILE
\(or OUTBUF if OUTFILE is nil). The actual return value is
@@ -717,16 +711,19 @@ FILE's modification time."
(setq load-name
(if (stringp generated-autoload-load-name)
generated-autoload-load-name
- (autoload-file-load-name absfile)))
+ (autoload-file-load-name absfile outfile)))
;; FIXME? Comparing file-names for equality with just equal
;; is fragile, eg if one has an automounter prefix and one
;; does not, but both refer to the same physical file.
(when (and outfile
+ (not outbuf)
(not
(if (memq system-type '(ms-dos windows-nt))
(equal (downcase outfile)
- (downcase (autoload-generated-file)))
- (equal outfile (autoload-generated-file)))))
+ (downcase (autoload-generated-file
+ outfile)))
+ (equal outfile (autoload-generated-file
+ outfile)))))
(setq otherbuf t))
(save-excursion
(save-restriction
@@ -740,7 +737,8 @@ FILE's modification time."
(file-name-sans-extension
(file-name-nondirectory file))))
(setq output-start (autoload--setup-output
- otherbuf outbuf absfile load-name))
+ otherbuf outbuf absfile
+ load-name outfile))
(let ((standard-output (marker-buffer output-start))
(print-quoted t))
(princ `(push (purecopy
@@ -758,7 +756,8 @@ FILE's modification time."
;; If not done yet, figure out where to insert this text.
(unless output-start
(setq output-start (autoload--setup-output
- otherbuf outbuf absfile load-name)))
+ otherbuf outbuf absfile
+ load-name outfile)))
(autoload--print-cookie-text output-start load-name file))
((= (following-char) ?\;)
;; Don't read the comment.
@@ -789,7 +788,7 @@ FILE's modification time."
((not otherbuf)
(unless output-start
(setq output-start (autoload--setup-output
- nil outbuf absfile load-name)))
+ nil outbuf absfile load-name outfile)))
(let ((autoload-print-form-outbuf
(marker-buffer output-start)))
(autoload-print-form form)))
@@ -801,9 +800,8 @@ FILE's modification time."
;; then passing otherbuf=nil is enough, but if
;; outbuf is nil, that won't cut it, so we
;; locally bind generated-autoload-file.
- (let ((generated-autoload-file
- (default-value 'generated-autoload-file)))
- (autoload--setup-output nil outbuf absfile load-name)))
+ (autoload--setup-output nil outbuf absfile load-name
+ outfile))
(autoload-print-form-outbuf
(marker-buffer other-output-start)))
(autoload-print-form form)
@@ -895,7 +893,7 @@ FILE's modification time."
(cons (lambda () (ignore-errors (delete-file tempfile)))
kill-emacs-hook)))
(unless (= temp-modes desired-modes)
- (set-file-modes tempfile desired-modes))
+ (set-file-modes tempfile desired-modes 'nofollow))
(write-region (point-min) (point-max) tempfile nil 1)
(backup-buffer)
(rename-file tempfile buffer-file-name t))
@@ -925,19 +923,23 @@ Return FILE if there was no autoload cookie in it, else nil."
(interactive (list (read-file-name "Update autoloads for file: ")
current-prefix-arg
(read-file-name "Write autoload definitions to file: ")))
- (let* ((generated-autoload-file (or outfile generated-autoload-file))
- (autoload-modified-buffers nil)
+ (setq outfile (or outfile generated-autoload-file))
+ (let* ((autoload-modified-buffers nil)
;; We need this only if the output file handles more than one input.
;; See https://debbugs.gnu.org/22213#38 and subsequent.
(autoload-timestamps t)
- (no-autoloads (autoload-generate-file-autoloads file)))
+ (no-autoloads (autoload-generate-file-autoloads
+ file nil
+ (if (local-variable-p 'generated-autoload-file)
+ generated-autoload-file
+ outfile))))
(if autoload-modified-buffers
(if save-after (autoload-save-buffers))
(if (called-interactively-p 'interactive)
(message "Autoload section for %s is up to date." file)))
(if no-autoloads file)))
-(defun autoload-find-destination (file load-name)
+(defun autoload-find-destination (file load-name output-file)
"Find the destination point of the current buffer's autoloads.
FILE is the file name of the current buffer.
LOAD-NAME is the name as it appears in the output.
@@ -947,12 +949,12 @@ removes any prior now out-of-date autoload entries."
(catch 'up-to-date
(let* ((buf (current-buffer))
(existing-buffer (if buffer-file-name buf))
- (output-file (autoload-generated-file))
+ (output-file (autoload-generated-file output-file))
(output-time (if (file-exists-p output-file)
(file-attribute-modification-time
(file-attributes output-file))))
(found nil))
- (with-current-buffer (autoload-find-generated-file)
+ (with-current-buffer (autoload-find-generated-file output-file)
;; This is to make generated-autoload-file have Unix EOLs, so
;; that it is portable to all platforms.
(or (eq 0 (coding-system-eol-type buffer-file-coding-system))
@@ -1033,12 +1035,31 @@ The function does NOT recursively descend into subdirectories of the
directory or directories specified.
In an interactive call, prompt for a default output file for the
-autoload definitions, and temporarily bind the variable
-`generated-autoload-file' to this value. When called from Lisp,
-use the existing value of `generated-autoload-file'. If any Lisp
-file binds `generated-autoload-file' as a file-local variable,
-write its autoloads into the specified file instead."
+autoload definitions. When called from Lisp, use the existing
+value of `generated-autoload-file'. If any Lisp file binds
+`generated-autoload-file' as a file-local variable, write its
+autoloads into the specified file instead."
+ (declare (obsolete make-directory-autoloads "28.1"))
(interactive "DUpdate autoloads from directory: ")
+ (make-directory-autoloads
+ dirs
+ (if (called-interactively-p 'interactive)
+ (read-file-name "Write autoload definitions to file: ")
+ generated-autoload-file)))
+
+;;;###autoload
+(defun make-directory-autoloads (dir output-file)
+ "Update autoload definitions for Lisp files in the directories DIRS.
+DIR can be either a single directory or a list of
+directories. (The latter usage is discouraged.)
+
+The autoloads will be written to OUTPUT-FILE. If any Lisp file
+binds `generated-autoload-file' as a file-local variable, write
+its autoloads into the specified file instead.
+
+The function does NOT recursively descend into subdirectories of the
+directory or directories specified."
+ (interactive "DUpdate autoloads from directory: \nFWrite to file: ")
(let* ((files-re (let ((tmp nil))
(dolist (suf (get-load-suffixes))
;; We don't use module-file-suffix below because
@@ -1049,10 +1070,10 @@ write its autoloads into the specified file instead."
(push suf tmp)))
(concat "\\`[^=.].*" (regexp-opt tmp t) "\\'")))
(files (apply #'nconc
- (mapcar (lambda (dir)
- (directory-files (expand-file-name dir)
- t files-re))
- dirs)))
+ (mapcar (lambda (d)
+ (directory-files (expand-file-name d)
+ t files-re))
+ (if (consp dir) dir (list dir)))))
(done ()) ;Files processed; to remove duplicates.
(changed nil) ;Non-nil if some change occurred.
(last-time)
@@ -1060,16 +1081,12 @@ write its autoloads into the specified file instead."
;; files because of file-local autoload-generated-file settings.
(no-autoloads nil)
(autoload-modified-buffers nil)
- (generated-autoload-file
- (if (called-interactively-p 'interactive)
- (read-file-name "Write autoload definitions to file: ")
- generated-autoload-file))
(output-time
- (if (file-exists-p generated-autoload-file)
- (file-attribute-modification-time
- (file-attributes generated-autoload-file)))))
+ (and (file-exists-p output-file)
+ (file-attribute-modification-time
+ (file-attributes output-file)))))
- (with-current-buffer (autoload-find-generated-file)
+ (with-current-buffer (autoload-find-generated-file output-file)
(save-excursion
;; Canonicalize file names and remove the autoload file itself.
(setq files (delete (file-relative-name buffer-file-name)
@@ -1124,10 +1141,9 @@ write its autoloads into the specified file instead."
;; Elements remaining in FILES have no existing autoload sections yet.
(let ((no-autoloads-time (or last-time '(0 0 0 0)))
(progress (make-progress-reporter
- (byte-compile-info-string
+ (byte-compile-info
(concat "Scraping files for "
- (file-relative-name
- generated-autoload-file)))
+ (file-relative-name output-file)))
0 (length files) nil 10))
(file-count 0)
file-time)
@@ -1167,6 +1183,19 @@ write its autoloads into the specified file instead."
;; file-local autoload-generated-file settings.
(autoload-save-buffers))))
+(defun batch-update-autoloads--summary (strings)
+ (let ((message ""))
+ (while strings
+ (when (> (length (concat message " " (car strings))) 64)
+ (byte-compile-info (concat message " ...") t "SCRAPE")
+ (setq message ""))
+ (setq message (if (zerop (length message))
+ (car strings)
+ (concat message " " (car strings))))
+ (setq strings (cdr strings)))
+ (when (> (length message) 0)
+ (byte-compile-info message t "SCRAPE"))))
+
;;;###autoload
(defun batch-update-autoloads ()
"Update loaddefs.el autoloads in batch mode.
@@ -1190,8 +1219,9 @@ should be non-nil)."
(or (string-match "\\`site-" file)
(push (expand-file-name file) autoload-excludes)))))))
(let ((args command-line-args-left))
+ (batch-update-autoloads--summary args)
(setq command-line-args-left nil)
- (apply #'update-directory-autoloads args)))
+ (make-directory-autoloads args generated-autoload-file)))
(provide 'autoload)
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index 8567a3a44f3..5413022e341 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -1,4 +1,4 @@
-;;; backquote.el --- implement the ` Lisp construct
+;;; backquote.el --- implement the ` Lisp construct -*- lexical-binding: t -*-
;; Copyright (C) 1990, 1992, 1994, 2001-2020 Free Software Foundation,
;; Inc.
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index a7fcc5cb8f2..2fa5a878801 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -81,7 +81,7 @@ result. The overhead of the `lambda's is accounted for."
(gcs (make-symbol "gcs"))
(gc (make-symbol "gc"))
(code (byte-compile `(lambda () ,@forms)))
- (lambda-code (byte-compile '(lambda ()))))
+ (lambda-code (byte-compile '(lambda ()))))
`(let ((,gc gc-elapsed)
(,gcs gcs-done))
(list ,(if (or (symbolp repetitions) (> repetitions 1))
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 850af93571f..0fd273aa3e3 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -149,9 +149,6 @@
;; | ip -- 4 byte vector
;; | bits LEN -- List with bits set in LEN bytes.
;;
-;; -- Note: 32 bit values may be limited by emacs' INTEGER
-;; implementation limits.
-;;
;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13)
;; and 0x1c 0x28 to (3 5 10 11 12).
@@ -301,7 +298,7 @@
type field
field nil))
(if (and (consp len) (not (eq type 'eval)))
- (setq len (apply 'bindat-get-field struct len)))
+ (setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(cond
@@ -560,7 +557,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
type field
field nil))
(if (and (consp len) (not (eq type 'eval)))
- (setq len (apply 'bindat-get-field struct len)))
+ (setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(cond
@@ -627,7 +624,7 @@ only that many elements from VECT."
(while (> i 0)
(setq i (1- i)
s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s)))
- (apply 'concat s)))
+ (apply #'concat s)))
(defun bindat-vector-to-dec (vect &optional sep)
"Format vector VECT in decimal format separated by dots.
@@ -635,7 +632,7 @@ If optional second arg SEP is a string, use that as separator."
(bindat-format-vector vect "%d" (if (stringp sep) sep ".")))
(defun bindat-vector-to-hex (vect &optional sep)
- "Format vector VECT in hex format separated by dots.
+ "Format vector VECT in hex format separated by colons.
If optional second arg SEP is a string, use that as separator."
(bindat-format-vector vect "%02x" (if (stringp sep) sep ":")))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 90ab8911c39..469bbe6c7c0 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -227,7 +227,7 @@
;;; byte-compile optimizers to support inlining
-(put 'inline 'byte-optimizer 'byte-optimize-inline-handler)
+(put 'inline 'byte-optimizer #'byte-optimize-inline-handler)
(defun byte-optimize-inline-handler (form)
"byte-optimize-handler for the `inline' special-form."
@@ -391,13 +391,6 @@
(and (nth 1 form)
(not for-effect)
form))
- ((eq (car-safe fn) 'lambda)
- (let ((newform (byte-compile-unfold-lambda form)))
- (if (eq newform form)
- ;; Some error occurred, avoid infinite recursion
- form
- (byte-optimize-form-code-walker newform for-effect))))
- ((eq (car-safe fn) 'closure) form)
((memq fn '(let let*))
;; recursively enter the optimizer for the bindings and body
;; of a let or let*. This for depth-firstness: forms that
@@ -444,13 +437,6 @@
;; will be optimized away in the lap-optimize pass.
(cons fn (byte-optimize-body (cdr form) for-effect)))
- ((eq fn 'with-output-to-temp-buffer)
- ;; this is just like the above, except for the first argument.
- (cons fn
- (cons
- (byte-optimize-form (nth 1 form) nil)
- (byte-optimize-body (cdr (cdr form)) for-effect))))
-
((eq fn 'if)
(when (< (length form) 3)
(byte-compile-warn "too few arguments for `if'"))
@@ -480,6 +466,13 @@
backwards)))))
(cons fn (mapcar 'byte-optimize-form (cdr form)))))
+ ((eq fn 'while)
+ (unless (consp (cdr form))
+ (byte-compile-warn "too few arguments for `while'"))
+ (cons fn
+ (cons (byte-optimize-form (cadr form) nil)
+ (byte-optimize-body (cddr form) t))))
+
((eq fn 'interactive)
(byte-compile-warn "misplaced interactive spec: `%s'"
(prin1-to-string form))
@@ -491,15 +484,12 @@
form)
((eq fn 'condition-case)
- (if byte-compile--use-old-handlers
- ;; Will be optimized later.
- form
- `(condition-case ,(nth 1 form) ;Not evaluated.
- ,(byte-optimize-form (nth 2 form) for-effect)
- ,@(mapcar (lambda (clause)
- `(,(car clause)
- ,@(byte-optimize-body (cdr clause) for-effect)))
- (nthcdr 3 form)))))
+ `(condition-case ,(nth 1 form) ;Not evaluated.
+ ,(byte-optimize-form (nth 2 form) for-effect)
+ ,@(mapcar (lambda (clause)
+ `(,(car clause)
+ ,@(byte-optimize-body (cdr clause) for-effect)))
+ (nthcdr 3 form))))
((eq fn 'unwind-protect)
;; the "protected" part of an unwind-protect is compiled (and thus
@@ -514,12 +504,7 @@
((eq fn 'catch)
(cons fn
(cons (byte-optimize-form (nth 1 form) nil)
- (if byte-compile--use-old-handlers
- ;; The body of a catch is compiled (and thus
- ;; optimized) as a top-level form, so don't do it
- ;; here.
- (cdr (cdr form))
- (byte-optimize-body (cdr form) for-effect)))))
+ (byte-optimize-body (cdr form) for-effect))))
((eq fn 'ignore)
;; Don't treat the args to `ignore' as being
@@ -531,6 +516,15 @@
;; Needed as long as we run byte-optimize-form after cconv.
((eq fn 'internal-make-closure) form)
+ ((eq (car-safe fn) 'lambda)
+ (let ((newform (byte-compile-unfold-lambda form)))
+ (if (eq newform form)
+ ;; Some error occurred, avoid infinite recursion
+ form
+ (byte-optimize-form newform for-effect))))
+
+ ((eq (car-safe fn) 'closure) form)
+
((byte-code-function-p fn)
(cons fn (mapcar #'byte-optimize-form (cdr form))))
@@ -555,20 +549,10 @@
;; Otherwise, no args can be considered to be for-effect,
;; even if the called function is for-effect, because we
;; don't know anything about that function.
- (let ((args (mapcar #'byte-optimize-form (cdr form))))
- (if (and (get fn 'pure)
- (byte-optimize-all-constp args))
- (list 'quote (apply fn (mapcar #'eval args)))
- (cons fn args)))))))
-
-(defun byte-optimize-all-constp (list)
- "Non-nil if all elements of LIST satisfy `macroexp-const-p'."
- (let ((constant t))
- (while (and list constant)
- (unless (macroexp-const-p (car list))
- (setq constant nil))
- (setq list (cdr list)))
- constant))
+ (let ((form (cons fn (mapcar #'byte-optimize-form (cdr form)))))
+ (if (get fn 'pure)
+ (byte-optimize-constant-args form)
+ form))))))
(defun byte-optimize-form (form &optional for-effect)
"The source-level pass of the optimizer."
@@ -664,45 +648,36 @@
(setq args (cons (car rest) args)))
(setq rest (cdr rest)))
(if (cdr constants)
- (if args
- (list (car form)
- (apply (car form) constants)
- (if (cdr args)
- (cons (car form) (nreverse args))
- (car args)))
- (apply (car form) constants))
- form)))
+ (let ((const (apply (car form) (nreverse constants))))
+ (if args
+ (append (list (car form) const)
+ (nreverse args))
+ const))
+ form)))
-;; Portable Emacs integers fall in this range.
-(defconst byte-opt--portable-max #x1fffffff)
-(defconst byte-opt--portable-min (- -1 byte-opt--portable-max))
-
-;; True if N is a number that works the same on all Emacs platforms.
-;; Portable Emacs fixnums are exactly representable as floats on all
-;; Emacs platforms, and (except for -0.0) any floating-point number
-;; that equals one of these integers must be the same on all
-;; platforms. Although other floating-point numbers such as 0.5 are
-;; also portable, it can be tricky to characterize them portably so
-;; they are not optimized.
-(defun byte-opt--portable-numberp (n)
- (and (numberp n)
- (<= byte-opt--portable-min n byte-opt--portable-max)
- (= n (floor n))
- (not (and (floatp n) (zerop n)
- (condition-case () (< (/ n) 0) (error))))))
-
-;; Use OP to reduce any leading prefix of portable numbers in the list
-;; (cons ACCUM ARGS) down to a single portable number, and return the
+(defun byte-optimize-min-max (form)
+ "Optimize `min' and `max'."
+ (let ((opt (byte-optimize-associative-math form)))
+ (if (and (consp opt) (memq (car opt) '(min max))
+ (= (length opt) 4))
+ ;; (OP x y z) -> (OP (OP x y) z), in order to use binary byte ops.
+ (list (car opt)
+ (list (car opt) (nth 1 opt) (nth 2 opt))
+ (nth 3 opt))
+ opt)))
+
+;; Use OP to reduce any leading prefix of constant numbers in the list
+;; (cons ACCUM ARGS) down to a single number, and return the
;; resulting list A of arguments. The idea is that applying OP to A
;; is equivalent to (but likely more efficient than) applying OP to
;; (cons ACCUM ARGS), on any Emacs platform. Do not make any special
;; provision for (- X) or (/ X); for example, it is the caller’s
;; responsibility that (- 1 0) should not be "optimized" to (- 1).
(defun byte-opt--arith-reduce (op accum args)
- (when (byte-opt--portable-numberp accum)
+ (when (numberp accum)
(let (accum1)
- (while (and (byte-opt--portable-numberp (car args))
- (byte-opt--portable-numberp
+ (while (and (numberp (car args))
+ (numberp
(setq accum1 (condition-case ()
(funcall op accum (car args))
(error))))
@@ -725,6 +700,9 @@
(integer (if integer-is-first arg1 arg2))
(other (if integer-is-first arg2 arg1)))
(list (if (eq integer 1) '1+ '1-) other)))
+ ;; (+ x y z) -> (+ (+ x y) z)
+ ((= (length args) 3)
+ `(+ ,(byte-optimize-plus `(+ ,(car args) ,(cadr args))) ,@(cddr args)))
;; not further optimized
((equal args (cdr form)) form)
(t (cons '+ args)))))
@@ -747,35 +725,19 @@
;; (- x -1) --> (1+ x)
((equal (cdr args) '(-1))
(list '1+ (car args)))
- ;; (- n) -> -n, where n and -n are portable numbers.
+ ;; (- n) -> -n, where n and -n are constant numbers.
;; This must be done separately since byte-opt--arith-reduce
;; is not applied to (- n).
((and (null (cdr args))
- (byte-opt--portable-numberp (car args))
- (byte-opt--portable-numberp (- (car args))))
+ (numberp (car args)))
(- (car args)))
+ ;; (- x y z) -> (- (- x y) z)
+ ((= (length args) 3)
+ `(- ,(byte-optimize-minus `(- ,(car args) ,(cadr args))) ,@(cddr args)))
;; not further optimized
((equal args (cdr form)) form)
(t (cons '- args))))))
-(defun byte-optimize-1+ (form)
- (let ((args (cdr form)))
- (when (null (cdr args))
- (let ((n (car args)))
- (when (and (byte-opt--portable-numberp n)
- (byte-opt--portable-numberp (1+ n)))
- (setq form (1+ n))))))
- form)
-
-(defun byte-optimize-1- (form)
- (let ((args (cdr form)))
- (when (null (cdr args))
- (let ((n (car args)))
- (when (and (byte-opt--portable-numberp n)
- (byte-opt--portable-numberp (1- n)))
- (setq form (1- n))))))
- form)
-
(defun byte-optimize-multiply (form)
(let* ((args (remq 1 (byte-opt--arith-reduce #'* 1 (cdr form)))))
(cond
@@ -783,6 +745,10 @@
((null args) 1)
;; (* n) -> n, where n is a number
((and (null (cdr args)) (numberp (car args))) (car args))
+ ;; (* x y z) -> (* (* x y) z)
+ ((= (length args) 3)
+ `(* ,(byte-optimize-multiply `(* ,(car args) ,(cadr args)))
+ ,@(cddr args)))
;; not further optimized
((equal args (cdr form)) form)
(t (cons '* args)))))
@@ -811,10 +777,10 @@
(condition-case ()
(list 'quote (eval form))
(error form)))
- (t ;; This can enable some lapcode optimizations.
+ (t ;; Moving the constant to the end can enable some lapcode optimizations.
(list (car form) (nth 2 form) (nth 1 form)))))
-(defun byte-optimize-predicate (form)
+(defun byte-optimize-constant-args (form)
(let ((ok t)
(rest (cdr form)))
(while (and rest ok)
@@ -829,9 +795,6 @@
(defun byte-optimize-identity (form)
(if (and (cdr form) (null (cdr (cdr form))))
(nth 1 form)
- (byte-compile-warn "identity called with %d arg%s, but requires 1"
- (length (cdr form))
- (if (= 1 (length (cdr form))) "" "s"))
form))
(defun byte-optimize--constant-symbol-p (expr)
@@ -864,21 +827,29 @@
;; Arity errors reported elsewhere.
form))
+(defun byte-optimize-assoc (form)
+ ;; Replace 2-argument `assoc' with `assq', `rassoc' with `rassq',
+ ;; if the first arg is a symbol.
+ (cond
+ ((/= (length form) 3)
+ form)
+ ((byte-optimize--constant-symbol-p (nth 1 form))
+ (cons (if (eq (car form) 'assoc) 'assq 'rassq)
+ (cdr form)))
+ (t (byte-optimize-constant-args form))))
+
(defun byte-optimize-memq (form)
;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar))
- (if (/= (length (cdr form)) 2)
- (byte-compile-warn "memq called with %d arg%s, but requires 2"
- (length (cdr form))
- (if (= 1 (length (cdr form))) "" "s"))
- (let ((list (nth 2 form)))
- (when (and (eq (car-safe list) 'quote)
+ (if (= (length (cdr form)) 2)
+ (let ((list (nth 2 form)))
+ (if (and (eq (car-safe list) 'quote)
(listp (setq list (cadr list)))
(= (length list) 1))
- (setq form (byte-optimize-and
- `(and ,(byte-optimize-predicate
- `(eq ,(nth 1 form) ',(nth 0 list)))
- ',list)))))
- (byte-optimize-predicate form)))
+ `(and (eq ,(nth 1 form) ',(nth 0 list))
+ ',list)
+ form))
+ ;; Arity errors reported elsewhere.
+ form))
(defun byte-optimize-concat (form)
"Merge adjacent constant arguments to `concat'."
@@ -907,58 +878,34 @@
form ; No improvement.
(cons 'concat (nreverse newargs)))))
-(put 'identity 'byte-optimizer 'byte-optimize-identity)
-(put 'memq 'byte-optimizer 'byte-optimize-memq)
-(put 'memql 'byte-optimizer 'byte-optimize-member)
-(put 'member 'byte-optimizer 'byte-optimize-member)
-
-(put '+ 'byte-optimizer 'byte-optimize-plus)
-(put '* 'byte-optimizer 'byte-optimize-multiply)
-(put '- 'byte-optimizer 'byte-optimize-minus)
-(put '/ 'byte-optimizer 'byte-optimize-divide)
-(put 'max 'byte-optimizer 'byte-optimize-associative-math)
-(put 'min 'byte-optimizer 'byte-optimize-associative-math)
-
-(put '= 'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'eq 'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'eql 'byte-optimizer 'byte-optimize-equal)
-(put 'equal 'byte-optimizer 'byte-optimize-equal)
-(put 'string= 'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate)
-
-(put '< 'byte-optimizer 'byte-optimize-predicate)
-(put '> 'byte-optimizer 'byte-optimize-predicate)
-(put '<= 'byte-optimizer 'byte-optimize-predicate)
-(put '>= 'byte-optimizer 'byte-optimize-predicate)
-(put '1+ 'byte-optimizer 'byte-optimize-1+)
-(put '1- 'byte-optimizer 'byte-optimize-1-)
-(put 'not 'byte-optimizer 'byte-optimize-predicate)
-(put 'null 'byte-optimizer 'byte-optimize-predicate)
-(put 'consp 'byte-optimizer 'byte-optimize-predicate)
-(put 'listp 'byte-optimizer 'byte-optimize-predicate)
-(put 'symbolp 'byte-optimizer 'byte-optimize-predicate)
-(put 'stringp 'byte-optimizer 'byte-optimize-predicate)
-(put 'string< 'byte-optimizer 'byte-optimize-predicate)
-(put 'string-lessp 'byte-optimizer 'byte-optimize-predicate)
-(put 'proper-list-p 'byte-optimizer 'byte-optimize-predicate)
-
-(put 'logand 'byte-optimizer 'byte-optimize-predicate)
-(put 'logior 'byte-optimizer 'byte-optimize-predicate)
-(put 'logxor 'byte-optimizer 'byte-optimize-predicate)
-(put 'lognot 'byte-optimizer 'byte-optimize-predicate)
-
-(put 'car 'byte-optimizer 'byte-optimize-predicate)
-(put 'cdr 'byte-optimizer 'byte-optimize-predicate)
-(put 'car-safe 'byte-optimizer 'byte-optimize-predicate)
-(put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
-
-(put 'concat 'byte-optimizer 'byte-optimize-concat)
+(put 'identity 'byte-optimizer #'byte-optimize-identity)
+(put 'memq 'byte-optimizer #'byte-optimize-memq)
+(put 'memql 'byte-optimizer #'byte-optimize-member)
+(put 'member 'byte-optimizer #'byte-optimize-member)
+(put 'assoc 'byte-optimizer #'byte-optimize-assoc)
+(put 'rassoc 'byte-optimizer #'byte-optimize-assoc)
+
+(put '+ 'byte-optimizer #'byte-optimize-plus)
+(put '* 'byte-optimizer #'byte-optimize-multiply)
+(put '- 'byte-optimizer #'byte-optimize-minus)
+(put '/ 'byte-optimizer #'byte-optimize-divide)
+(put 'max 'byte-optimizer #'byte-optimize-min-max)
+(put 'min 'byte-optimizer #'byte-optimize-min-max)
+
+(put '= 'byte-optimizer #'byte-optimize-binary-predicate)
+(put 'eq 'byte-optimizer #'byte-optimize-binary-predicate)
+(put 'eql 'byte-optimizer #'byte-optimize-equal)
+(put 'equal 'byte-optimizer #'byte-optimize-equal)
+(put 'string= 'byte-optimizer #'byte-optimize-binary-predicate)
+(put 'string-equal 'byte-optimizer #'byte-optimize-binary-predicate)
+
+(put 'concat 'byte-optimizer #'byte-optimize-concat)
;; I'm not convinced that this is necessary. Doesn't the optimizer loop
;; take care of this? - Jamie
;; I think this may some times be necessary to reduce ie (quote 5) to 5,
;; so arithmetic optimizers recognize the numeric constant. - Hallvard
-(put 'quote 'byte-optimizer 'byte-optimize-quote)
+(put 'quote 'byte-optimizer #'byte-optimize-quote)
(defun byte-optimize-quote (form)
(if (or (consp (nth 1 form))
(and (symbolp (nth 1 form))
@@ -981,7 +928,7 @@
nil))
((null (cdr (cdr form)))
(nth 1 form))
- ((byte-optimize-predicate form))))
+ ((byte-optimize-constant-args form))))
(defun byte-optimize-or (form)
;; Throw away nil's, and simplify if less than 2 args.
@@ -994,7 +941,7 @@
(setq form (copy-sequence form)
rest (setcdr (memq (car rest) form) nil))))
(if (cdr (cdr form))
- (byte-optimize-predicate form)
+ (byte-optimize-constant-args form)
(nth 1 form))))
(defun byte-optimize-cond (form)
@@ -1076,16 +1023,16 @@
(if (nth 1 form)
form))
-(put 'and 'byte-optimizer 'byte-optimize-and)
-(put 'or 'byte-optimizer 'byte-optimize-or)
-(put 'cond 'byte-optimizer 'byte-optimize-cond)
-(put 'if 'byte-optimizer 'byte-optimize-if)
-(put 'while 'byte-optimizer 'byte-optimize-while)
+(put 'and 'byte-optimizer #'byte-optimize-and)
+(put 'or 'byte-optimizer #'byte-optimize-or)
+(put 'cond 'byte-optimizer #'byte-optimize-cond)
+(put 'if 'byte-optimizer #'byte-optimize-if)
+(put 'while 'byte-optimizer #'byte-optimize-while)
;; byte-compile-negation-optimizer lives in bytecomp.el
-(put '/= 'byte-optimizer 'byte-compile-negation-optimizer)
-(put 'atom 'byte-optimizer 'byte-compile-negation-optimizer)
-(put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer)
+(put '/= 'byte-optimizer #'byte-compile-negation-optimizer)
+(put 'atom 'byte-optimizer #'byte-compile-negation-optimizer)
+(put 'nlistp 'byte-optimizer #'byte-compile-negation-optimizer)
(defun byte-optimize-funcall (form)
@@ -1099,26 +1046,29 @@
(defun byte-optimize-apply (form)
;; If the last arg is a literal constant, turn this into a funcall.
;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
- (let ((fn (nth 1 form))
- (last (nth (1- (length form)) form))) ; I think this really is fastest
- (or (if (or (null last)
- (eq (car-safe last) 'quote))
- (if (listp (nth 1 last))
- (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
- (nconc (list 'funcall fn) butlast
- (mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
- (byte-compile-warn
- "last arg to apply can't be a literal atom: `%s'"
- (prin1-to-string last))
- nil))
- form)))
-
-(put 'funcall 'byte-optimizer 'byte-optimize-funcall)
-(put 'apply 'byte-optimizer 'byte-optimize-apply)
-
-
-(put 'let 'byte-optimizer 'byte-optimize-letX)
-(put 'let* 'byte-optimizer 'byte-optimize-letX)
+ (if (= (length form) 2)
+ ;; single-argument `apply' is not worth optimizing (bug#40968)
+ form
+ (let ((fn (nth 1 form))
+ (last (nth (1- (length form)) form))) ; I think this really is fastest
+ (or (if (or (null last)
+ (eq (car-safe last) 'quote))
+ (if (listp (nth 1 last))
+ (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
+ (nconc (list 'funcall fn) butlast
+ (mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
+ (byte-compile-warn
+ "last arg to apply can't be a literal atom: `%s'"
+ (prin1-to-string last))
+ nil))
+ form))))
+
+(put 'funcall 'byte-optimizer #'byte-optimize-funcall)
+(put 'apply 'byte-optimizer #'byte-optimize-apply)
+
+
+(put 'let 'byte-optimizer #'byte-optimize-letX)
+(put 'let* 'byte-optimizer #'byte-optimize-letX)
(defun byte-optimize-letX (form)
(cond ((null (nth 1 form))
;; No bindings
@@ -1134,17 +1084,17 @@
(list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil)))))
-(put 'nth 'byte-optimizer 'byte-optimize-nth)
+(put 'nth 'byte-optimizer #'byte-optimize-nth)
(defun byte-optimize-nth (form)
(if (= (safe-length form) 3)
(if (memq (nth 1 form) '(0 1))
(list 'car (if (zerop (nth 1 form))
(nth 2 form)
(list 'cdr (nth 2 form))))
- (byte-optimize-predicate form))
+ form)
form))
-(put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr)
+(put 'nthcdr 'byte-optimizer #'byte-optimize-nthcdr)
(defun byte-optimize-nthcdr (form)
(if (= (safe-length form) 3)
(if (memq (nth 1 form) '(0 1 2))
@@ -1153,14 +1103,14 @@
(while (>= (setq count (1- count)) 0)
(setq form (list 'cdr form)))
form)
- (byte-optimize-predicate form))
+ form)
form))
;; Fixme: delete-char -> delete-region (byte-coded)
;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
;; string-make-multibyte for constant args.
-(put 'set 'byte-optimizer 'byte-optimize-set)
+(put 'set 'byte-optimizer #'byte-optimize-set)
(defun byte-optimize-set (form)
(let ((var (car-safe (cdr-safe form))))
(cond
@@ -1196,13 +1146,15 @@
;; I wonder if I missed any :-\)
(let ((side-effect-free-fns
'(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
- assoc assq
+ assq
+ bool-vector-count-consecutive bool-vector-count-population
+ bool-vector-subsetp
boundp buffer-file-name buffer-local-variables buffer-modified-p
buffer-substring byte-code-function-p
capitalize car-less-than-car car cdr ceiling char-after char-before
char-equal char-to-string char-width compare-strings
compare-window-configurations concat coordinates-in-window-p
- copy-alist copy-sequence copy-marker cos count-lines
+ copy-alist copy-sequence copy-marker copysign cos count-lines
current-time-string current-time-zone
decode-char
decode-time default-boundp default-value documentation downcase
@@ -1215,21 +1167,22 @@
frame-visible-p fround ftruncate
get gethash get-buffer get-buffer-window getenv get-file-buffer
hash-table-count
- int-to-string intern-soft
+ int-to-string intern-soft isnan
keymap-parent
- length line-beginning-position line-end-position
+ lax-plist-get ldexp length line-beginning-position line-end-position
local-variable-if-set-p local-variable-p locale-info
log log10 logand logb logcount logior lognot logxor lsh
- make-list make-string make-symbol marker-buffer max member memq min
- minibuffer-selected-window minibuffer-window
+ make-byte-code make-list make-string make-symbol marker-buffer max
+ member memq memql min minibuffer-selected-window minibuffer-window
mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
parse-colon-path plist-get plist-member
prefix-numeric-value previous-window prin1-to-string propertize
degrees-to-radians
- radians-to-degrees rassq rassoc read-from-string regexp-quote
- region-beginning region-end reverse round
- sin sqrt string string< string= string-equal string-lessp string-to-char
- string-to-number substring
+ radians-to-degrees rassq rassoc read-from-string regexp-opt
+ regexp-quote region-beginning region-end reverse round
+ sin sqrt string string< string= string-equal string-lessp
+ string-search string-to-char
+ string-to-number string-to-syntax substring
sxhash sxhash-equal sxhash-eq sxhash-eql
symbol-function symbol-name symbol-plist symbol-value string-make-unibyte
string-make-multibyte string-as-multibyte string-as-unibyte
@@ -1279,7 +1232,7 @@
standard-case-table standard-syntax-table stringp subrp symbolp
syntax-table syntax-table-p
this-command-keys this-command-keys-vector this-single-command-keys
- this-single-command-raw-keys
+ this-single-command-raw-keys type-of
user-real-login-name user-real-uid user-uid
vector vectorp visible-frame-list
wholenump window-configuration-p window-live-p
@@ -1296,9 +1249,9 @@
;; Pure functions are side-effect free functions whose values depend
;; only on their arguments, not on the platform. For these functions,
;; calls with constant arguments can be evaluated at compile time.
-;; This may shift runtime errors to compile time. For example, logand
-;; is pure since its results are machine-independent, whereas ash is
-;; not pure because (ash 1 29)'s value depends on machine word size.
+;; For example, ash is pure since its results are machine-independent,
+;; whereas lsh is not pure because (lsh -1 -1)'s value depends on the
+;; fixnum range.
;;
;; When deciding whether a function is pure, do not worry about
;; mutable strings or markers, as they are so unlikely in real code
@@ -1308,9 +1261,42 @@
;; values if a marker is moved.
(let ((pure-fns
- '(% concat logand logcount logior lognot logxor
- regexp-opt regexp-quote
- string-to-char string-to-syntax symbol-name)))
+ '(concat regexp-opt regexp-quote
+ string-to-char string-to-syntax symbol-name
+ eq eql
+ = /= < <= >= > min max
+ + - * / % mod abs ash 1+ 1- sqrt
+ logand logior lognot logxor logcount
+ copysign isnan ldexp float logb
+ floor ceiling round truncate
+ ffloor fceiling fround ftruncate
+ string= string-equal string< string-lessp
+ string-search
+ consp atom listp nlistp proper-list-p
+ sequencep arrayp vectorp stringp bool-vector-p hash-table-p
+ null not
+ numberp integerp floatp natnump characterp
+ integer-or-marker-p number-or-marker-p char-or-string-p
+ symbolp keywordp
+ type-of
+ identity ignore
+
+ ;; The following functions are pure up to mutation of their
+ ;; arguments. This is pure enough for the purposes of
+ ;; constant folding, but not necessarily for all kinds of
+ ;; code motion.
+ car cdr car-safe cdr-safe nth nthcdr last
+ equal
+ length safe-length
+ memq memql member
+ ;; `assoc' and `assoc-default' are excluded since they are
+ ;; impure if the test function is (consider `string-match').
+ assq rassq rassoc
+ plist-get lax-plist-get plist-member
+ aref elt
+ bool-vector-subsetp
+ bool-vector-count-population bool-vector-count-consecutive
+ )))
(while pure-fns
(put (car pure-fns) 'pure t)
(setq pure-fns (cdr pure-fns)))
@@ -1473,10 +1459,10 @@
(setq rest (cdr rest))))
(if tags (error "optimizer error: missed tags %s" tags))
;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )
- (mapcar (function (lambda (elt)
- (if (numberp elt)
- elt
- (cdr elt))))
+ (mapcar (lambda (elt)
+ (if (numberp elt)
+ elt
+ (cdr elt)))
(nreverse lap))))
@@ -1510,13 +1496,13 @@
byte-current-buffer byte-stack-ref))
(defconst byte-compile-side-effect-free-ops
- (nconc
+ (append
'(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt
- byte-member byte-assq byte-quo byte-rem)
+ byte-member byte-assq byte-quo byte-rem byte-substring)
byte-compile-side-effect-and-error-free-ops))
;; This crock is because of the way DEFVAR_BOOL variables work.
@@ -2195,7 +2181,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(or noninteractive (message "compiling %s...done" x)))
'(byte-optimize-form
byte-optimize-body
- byte-optimize-predicate
+ byte-optimize-constant-args
byte-optimize-binary-predicate
;; Inserted some more than necessary, to speed it up.
byte-optimize-form-code-walker
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 70fe06085dc..27f54d0ca2a 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -82,65 +82,84 @@ The return value of this function is not used."
;; We define macro-declaration-alist here because it is needed to
;; handle declarations in macro definitions and this is the first file
-;; loaded by loadup.el that uses declarations in macros.
+;; loaded by loadup.el that uses declarations in macros. We specify
+;; the values as named aliases so that `describe-variable' prints
+;; something useful; cf. Bug#40491. We can only use backquotes inside
+;; the lambdas and not for those properties that are used by functions
+;; loaded before backquote.el.
+
+(defalias 'byte-run--set-advertised-calling-convention
+ #'(lambda (f _args arglist when)
+ (list 'set-advertised-calling-convention
+ (list 'quote f) (list 'quote arglist) (list 'quote when))))
+
+(defalias 'byte-run--set-obsolete
+ #'(lambda (f _args new-name when)
+ (list 'make-obsolete
+ (list 'quote f) (list 'quote new-name) (list 'quote when))))
+
+(defalias 'byte-run--set-interactive-only
+ #'(lambda (f _args instead)
+ (list 'function-put (list 'quote f)
+ ''interactive-only (list 'quote instead))))
+
+(defalias 'byte-run--set-pure
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''pure (list 'quote val))))
+
+(defalias 'byte-run--set-side-effect-free
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''side-effect-free (list 'quote val))))
+
+(defalias 'byte-run--set-compiler-macro
+ #'(lambda (f args compiler-function)
+ (if (not (eq (car-safe compiler-function) 'lambda))
+ `(eval-and-compile
+ (function-put ',f 'compiler-macro #',compiler-function))
+ (let ((cfname (intern (concat (symbol-name f) "--anon-cmacro")))
+ ;; Avoid cadr/cddr so we can use `compiler-macro' before
+ ;; defining cadr/cddr.
+ (data (cdr compiler-function)))
+ `(progn
+ (eval-and-compile
+ (function-put ',f 'compiler-macro #',cfname))
+ ;; Don't autoload the compiler-macro itself, since the
+ ;; macroexpander will find this file via `f's autoload,
+ ;; if needed.
+ :autoload-end
+ (eval-and-compile
+ (defun ,cfname (,@(car data) ,@args)
+ ,@(cdr data))))))))
+
+(defalias 'byte-run--set-doc-string
+ #'(lambda (f _args pos)
+ (list 'function-put (list 'quote f)
+ ''doc-string-elt (list 'quote pos))))
+
+(defalias 'byte-run--set-indent
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''lisp-indent-function (list 'quote val))))
;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist
(list
- ;; We can only use backquotes inside the lambdas and not for those
- ;; properties that are used by functions loaded before backquote.el.
(list 'advertised-calling-convention
- #'(lambda (f _args arglist when)
- (list 'set-advertised-calling-convention
- (list 'quote f) (list 'quote arglist) (list 'quote when))))
- (list 'obsolete
- #'(lambda (f _args new-name when)
- (list 'make-obsolete
- (list 'quote f) (list 'quote new-name) (list 'quote when))))
- (list 'interactive-only
- #'(lambda (f _args instead)
- (list 'function-put (list 'quote f)
- ''interactive-only (list 'quote instead))))
+ #'byte-run--set-advertised-calling-convention)
+ (list 'obsolete #'byte-run--set-obsolete)
+ (list 'interactive-only #'byte-run--set-interactive-only)
;; FIXME: Merge `pure' and `side-effect-free'.
- (list 'pure
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''pure (list 'quote val)))
+ (list 'pure #'byte-run--set-pure
"If non-nil, the compiler can replace calls with their return value.
This may shift errors from run-time to compile-time.")
- (list 'side-effect-free
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''side-effect-free (list 'quote val)))
+ (list 'side-effect-free #'byte-run--set-side-effect-free
"If non-nil, calls can be ignored if their value is unused.
If `error-free', drop calls even if `byte-compile-delete-errors' is nil.")
- (list 'compiler-macro
- #'(lambda (f args compiler-function)
- (if (not (eq (car-safe compiler-function) 'lambda))
- `(eval-and-compile
- (function-put ',f 'compiler-macro #',compiler-function))
- (let ((cfname (intern (concat (symbol-name f) "--anon-cmacro")))
- ;; Avoid cadr/cddr so we can use `compiler-macro' before
- ;; defining cadr/cddr.
- (data (cdr compiler-function)))
- `(progn
- (eval-and-compile
- (function-put ',f 'compiler-macro #',cfname))
- ;; Don't autoload the compiler-macro itself, since the
- ;; macroexpander will find this file via `f's autoload,
- ;; if needed.
- :autoload-end
- (eval-and-compile
- (defun ,cfname (,@(car data) ,@args)
- ,@(cdr data))))))))
- (list 'doc-string
- #'(lambda (f _args pos)
- (list 'function-put (list 'quote f)
- ''doc-string-elt (list 'quote pos))))
- (list 'indent
- #'(lambda (f _args val)
- (list 'function-put (list 'quote f)
- ''lisp-indent-function (list 'quote val)))))
+ (list 'compiler-macro #'byte-run--set-compiler-macro)
+ (list 'doc-string #'byte-run--set-doc-string)
+ (list 'indent #'byte-run--set-indent))
"List associating function properties to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is
a function. For each (PROP . VALUES) in a function's declaration,
@@ -150,18 +169,22 @@ to set this property.
This is used by `declare'.")
+(defalias 'byte-run--set-debug
+ #'(lambda (name _args spec)
+ (list 'progn :autoload-end
+ (list 'put (list 'quote name)
+ ''edebug-form-spec (list 'quote spec)))))
+
+(defalias 'byte-run--set-no-font-lock-keyword
+ #'(lambda (name _args val)
+ (list 'function-put (list 'quote name)
+ ''no-font-lock-keyword (list 'quote val))))
+
(defvar macro-declarations-alist
(cons
- (list 'debug
- #'(lambda (name _args spec)
- (list 'progn :autoload-end
- (list 'put (list 'quote name)
- ''edebug-form-spec (list 'quote spec)))))
+ (list 'debug #'byte-run--set-debug)
(cons
- (list 'no-font-lock-keyword
- #'(lambda (name _args val)
- (list 'function-put (list 'quote name)
- ''no-font-lock-keyword (list 'quote val))))
+ (list 'no-font-lock-keyword #'byte-run--set-no-font-lock-keyword)
defun-declarations-alist))
"List associating properties of macros to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is a function.
@@ -409,7 +432,16 @@ ACCESS-TYPE if non-nil should specify the kind of access that will trigger
(defmacro define-obsolete-variable-alias (obsolete-name current-name
&optional when docstring)
"Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete.
-This uses `defvaralias' and `make-obsolete-variable' (which see).
+
+WHEN should be a string indicating when the variable was first
+made obsolete, for example a date or a release number.
+
+This macro evaluates all its parameters, and both OBSOLETE-NAME
+and CURRENT-NAME should be symbols, so a typical usage would look like:
+
+ (define-obsolete-variable-alias 'foo-thing 'bar-thing \"27.1\")
+
+This macro uses `defvaralias' and `make-obsolete-variable' (which see).
See the Info node `(elisp)Variable Aliases' for more details.
If CURRENT-NAME is a defcustom or a defvar (more generally, any variable
@@ -423,9 +455,6 @@ dumped with Emacs). This is so that any user customizations are
applied before the defcustom tries to initialize the
variable (this is due to the way `defvaralias' works).
-WHEN should be a string indicating when the variable was first
-made obsolete, for example a date or a release number.
-
For the benefit of Customize, if OBSOLETE-NAME has
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
@@ -553,13 +582,26 @@ Otherwise, return nil. For internal use only."
(mapconcat (lambda (char) (format "`?\\%c'" char))
sorted ", ")))))
+(defun byte-compile-info (string &optional message type)
+ "Format STRING in a way that looks pleasing in the compilation output.
+If MESSAGE, output the message, too.
+
+If TYPE, it should be a string that says what the information
+type is. This defaults to \"INFO\"."
+ (let ((string (format " %-9s%s" (or type "INFO") string)))
+ (when message
+ (message "%s" string))
+ string))
+
(defun byte-compile-info-string (&rest args)
"Format ARGS in a way that looks pleasing in the compilation output."
- (format " %-9s%s" "INFO" (apply #'format args)))
+ (declare (obsolete byte-compile-info "28.1"))
+ (byte-compile-info (apply #'format args)))
(defun byte-compile-info-message (&rest args)
"Message format ARGS in a way that looks pleasing in the compilation output."
- (message "%s" (apply #'byte-compile-info-string args)))
+ (declare (obsolete byte-compile-info "28.1"))
+ (byte-compile-info (apply #'format args) t))
;; I nuked this because it's not a good idea for users to think of using it.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 90745a3a2f3..cbda16d051b 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -268,6 +268,13 @@ This option is enabled by default because it reduces Emacs memory usage."
(defconst byte-compile-log-buffer "*Compile-Log*"
"Name of the byte-compiler's log buffer.")
+(defvar byte-compile--known-dynamic-vars nil
+ "Variables known to be declared as dynamic, for warning purposes.
+Each element is (VAR . FILE), indicating that VAR is declared in FILE.")
+
+(defvar byte-compile--seen-defvars nil
+ "All dynamic variable declarations seen so far.")
+
(defcustom byte-optimize-log nil
"If non-nil, the byte-compiler will log its optimizations.
If this is `source', then only source-level optimizations will be logged.
@@ -284,13 +291,13 @@ The information is logged to `byte-compile-log-buffer'."
;; This needs to be autoloaded because it needs to be available to
;; Emacs before the byte compiler is loaded, otherwise Emacs will not
;; know that this variable is marked as safe until it is too late.
-;; (See https://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00261.html )
+;; (See https://lists.gnu.org/r/emacs-devel/2018-01/msg00261.html )
;;;###autoload(put 'byte-compile-error-on-warn 'safe-local-variable 'booleanp)
(defconst byte-compile-warning-types
'(redefine callargs free-vars unresolved
obsolete noruntime cl-functions interactive-only
- make-local mapcar constants suspicious lexical)
+ make-local mapcar constants suspicious lexical lexical-dynamic)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
"List of warnings that the byte-compiler should issue (t for all).
@@ -310,6 +317,8 @@ Elements of the list may be:
interactive-only
commands that normally shouldn't be called from Lisp code.
lexical global/dynamic variables lacking a prefix.
+ lexical-dynamic
+ lexically bound variable declared dynamic elsewhere
make-local calls to make-variable-buffer-local that may be incorrect.
mapcar mapcar called for effect.
constants let-binding of, or assignment to, constants/nonvariables.
@@ -719,14 +728,15 @@ otherwise pop it")
"to make a binding to record entire window configuration")
(byte-defop 140 0 byte-save-restriction
"to make a binding to record the current buffer clipping restrictions")
-(byte-defop 141 -1 byte-catch
+(byte-defop 141 -1 byte-catch-OBSOLETE ; Not generated since Emacs 25.
"for catch. Takes, on stack, the tag and an expression for the body")
(byte-defop 142 -1 byte-unwind-protect
"for unwind-protect. Takes, on stack, an expression for the unwind-action")
;; For condition-case. Takes, on stack, the variable to bind,
;; an expression for the body, and a list of clauses.
-(byte-defop 143 -2 byte-condition-case)
+;; Not generated since Emacs 25.
+(byte-defop 143 -2 byte-condition-case-OBSOLETE)
(byte-defop 144 0 byte-temp-output-buffer-setup-OBSOLETE)
(byte-defop 145 -1 byte-temp-output-buffer-show-OBSOLETE)
@@ -1201,7 +1211,7 @@ message buffer `default-directory'."
byte-compile-last-warned-form))))
(insert (format "\nIn %s:\n" form)))
(when level
- (insert (format "%s%s" file pos))))
+ (insert (format "%s%s " file pos))))
(setq byte-compile-last-logged-file byte-compile-current-file
byte-compile-last-warned-form byte-compile-current-form)
entry)
@@ -1835,10 +1845,9 @@ compile FILENAME. If optional argument ARG is 0, it compiles
the input file even if the `.elc' file does not exist.
Any other non-nil value of ARG means to ask the user.
-If optional argument LOAD is non-nil, loads the file after compiling.
-
If compilation is needed, this functions returns the result of
`byte-compile-file'; otherwise it returns `no-byte-compile'."
+ (declare (advertised-calling-convention (filename &optional force arg) "28.1"))
(interactive
(let ((file buffer-file-name)
(file-name nil)
@@ -1867,11 +1876,24 @@ If compilation is needed, this functions returns the result of
(progn
(if (and noninteractive (not byte-compile-verbose))
(message "Compiling %s..." filename))
- (byte-compile-file filename load))
+ (byte-compile-file filename)
+ (when load
+ (load (if (file-exists-p dest) dest filename))))
(when load
(load (if (file-exists-p dest) dest filename)))
'no-byte-compile)))
+(defun byte-compile--load-dynvars (file)
+ (and file (not (equal file ""))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (let ((vars nil)
+ var)
+ (while (ignore-errors (setq var (read (current-buffer))))
+ (push var vars))
+ vars))))
+
(defvar byte-compile-level 0 ; bug#13787
"Depth of a recursive byte compilation.")
@@ -1880,8 +1902,10 @@ If compilation is needed, this functions returns the result of
"Compile a file of Lisp code named FILENAME into a file of byte code.
The output file's name is generated by passing FILENAME to the
function `byte-compile-dest-file' (which see).
-With prefix arg (noninteractively: 2nd arg), LOAD the file after compiling.
-The value is non-nil if there were no errors, nil if errors."
+The value is non-nil if there were no errors, nil if errors.
+
+See also `emacs-lisp-byte-compile-and-load'."
+ (declare (advertised-calling-convention (filename) "28.1"))
;; (interactive "fByte compile file: \nP")
(interactive
(let ((file buffer-file-name)
@@ -1910,8 +1934,11 @@ The value is non-nil if there were no errors, nil if errors."
(let ((byte-compile-current-file filename)
(byte-compile-current-group nil)
(set-auto-coding-for-load t)
+ (byte-compile--seen-defvars nil)
+ (byte-compile--known-dynamic-vars
+ (byte-compile--load-dynvars (getenv "EMACS_DYNVARS_FILE")))
target-file input-buffer output-buffer
- byte-compile-dest-file)
+ byte-compile-dest-file byte-compiler-error-flag)
(setq target-file (byte-compile-dest-file filename))
(setq byte-compile-dest-file target-file)
(with-current-buffer
@@ -1973,7 +2000,6 @@ The value is non-nil if there were no errors, nil if errors."
'no-byte-compile)
(when byte-compile-verbose
(message "Compiling %s..." filename))
- (setq byte-compiler-error-flag nil)
;; It is important that input-buffer not be current at this call,
;; so that the value of point set in input-buffer
;; within byte-compile-from-buffer lingers in that buffer.
@@ -2007,7 +2033,7 @@ The value is non-nil if there were no errors, nil if errors."
(delete-file tempfile)))
kill-emacs-hook)))
(unless (= temp-modes desired-modes)
- (set-file-modes tempfile desired-modes))
+ (set-file-modes tempfile desired-modes 'nofollow))
(write-region (point-min) (point-max) tempfile nil 1)
;; This has the intentional side effect that any
;; hard-links to target-file continue to
@@ -2034,8 +2060,17 @@ The value is non-nil if there were no errors, nil if errors."
filename))))
(save-excursion
(display-call-tree filename)))
+ (let ((gen-dynvars (getenv "EMACS_GENERATE_DYNVARS")))
+ (when (and gen-dynvars (not (equal gen-dynvars ""))
+ byte-compile--seen-defvars)
+ (let ((dynvar-file (concat target-file ".dynvars")))
+ (message "Generating %s" dynvar-file)
+ (with-temp-buffer
+ (dolist (var (delete-dups byte-compile--seen-defvars))
+ (insert (format "%S\n" (cons var filename))))
+ (write-region (point-min) (point-max) dynvar-file)))))
(if load
- (load target-file))
+ (load target-file))
t))))
;;; compiling a single function
@@ -2139,55 +2174,13 @@ With argument ARG, insert value in current buffer after the form."
;; Make warnings about unresolved functions
;; give the end of the file as their position.
(setq byte-compile-last-position (point-max))
- (byte-compile-warn-about-unresolved-functions))
- ;; Fix up the header at the front of the output
- ;; if the buffer contains multibyte characters.
- (and byte-compile-current-file
- (with-current-buffer byte-compile--outbuffer
- (byte-compile-fix-header byte-compile-current-file))))
+ (byte-compile-warn-about-unresolved-functions)))
byte-compile--outbuffer)))
-(defun byte-compile-fix-header (_filename)
- "If the current buffer has any multibyte characters, insert a version test."
- (when (< (point-max) (position-bytes (point-max)))
- (goto-char (point-min))
- ;; Find the comment that describes the version condition.
- (search-forward "\n;;; This file uses")
- (narrow-to-region (line-beginning-position) (point-max))
- ;; Find the first line of ballast semicolons.
- (search-forward ";;;;;;;;;;")
- (beginning-of-line)
- (narrow-to-region (point-min) (point))
- (let ((old-header-end (point))
- (minimum-version "23")
- delta)
- (delete-region (point-min) (point-max))
- (insert
- ";;; This file contains utf-8 non-ASCII characters,\n"
- ";;; and so cannot be loaded into Emacs 22 or earlier.\n"
- ;; Have to check if emacs-version is bound so that this works
- ;; in files loaded early in loadup.el.
- "(and (boundp 'emacs-version)\n"
- ;; If there is a name at the end of emacs-version,
- ;; don't try to check the version number.
- " (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
- (format " (string-lessp emacs-version \"%s\")\n" minimum-version)
- ;; Because the header must fit in a fixed width, we cannot
- ;; insert arbitrary-length file names (Bug#11585).
- " (error \"`%s' was compiled for "
- (format "Emacs %s or later\" #$))\n\n" minimum-version))
- ;; Now compensate for any change in size, to make sure all
- ;; positions in the file remain valid.
- (setq delta (- (point-max) old-header-end))
- (goto-char (point-max))
- (widen)
- (delete-char delta))))
-
(defun byte-compile-insert-header (_filename outbuffer)
"Insert a header at the start of OUTBUFFER.
Call from the source buffer."
- (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
- (dynamic byte-compile-dynamic)
+ (let ((dynamic byte-compile-dynamic)
(optimize byte-optimize))
(with-current-buffer outbuffer
(goto-char (point-min))
@@ -2201,7 +2194,19 @@ Call from the source buffer."
;; 0 string ;ELC GNU Emacs Lisp compiled file,
;; >4 byte x version %d
(insert
- ";ELC" 23 "\000\000\000\n"
+ ";ELC"
+ (let ((version
+ (if (zerop emacs-minor-version)
+ ;; Let's allow silently loading into Emacs-27
+ ;; files compiled with Emacs-28.0.NN since the two can
+ ;; be almost identical (e.g. right after cutting the
+ ;; release branch) and people running the development
+ ;; branch can be presumed to know that it's risky anyway.
+ (1- emacs-major-version) emacs-major-version)))
+ ;; Make sure the version is a plain byte that doesn't end the comment!
+ (cl-assert (and (> version 13) (< version 128)))
+ version)
+ "\000\000\000\n"
";;; Compiled\n"
";;; in Emacs version " emacs-version "\n"
";;; with"
@@ -2213,19 +2218,7 @@ Call from the source buffer."
".\n"
(if dynamic ";;; Function definitions are lazy-loaded.\n"
"")
- "\n;;; This file uses "
- (if dynamic-docstrings
- "dynamic docstrings, first added in Emacs 19.29"
- "opcodes that do not exist in Emacs 18")
- ".\n\n"
- ;; Note that byte-compile-fix-header may change this.
- ";;; This file does not contain utf-8 non-ASCII characters,\n"
- ";;; and so can be loaded in Emacs versions earlier than 23.\n\n"
- ;; Insert semicolons as ballast, so that byte-compile-fix-header
- ;; can delete them so as to keep the buffer positions
- ;; constant for the actual compiled code.
- ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
- ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))))
+ "\n\n"))))
(defun byte-compile-output-file-form (form)
;; Write the given form to the output buffer, being careful of docstrings
@@ -2466,7 +2459,8 @@ list that represents a doc string reference.
(setq byte-compile-lexical-variables
(delq sym byte-compile-lexical-variables))
(byte-compile-warn "Variable `%S' declared after its first use" sym))
- (push sym byte-compile-bound-variables))
+ (push sym byte-compile-bound-variables)
+ (push sym byte-compile--seen-defvars))
(defun byte-compile-file-form-defvar (form)
(let ((sym (nth 1 form)))
@@ -2872,6 +2866,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(ash nonrest 8)
(ash rest 7)))))
+(defun byte-compile--warn-lexical-dynamic (var context)
+ (when (byte-compile-warning-enabled-p 'lexical-dynamic var)
+ (byte-compile-warn
+ "`%s' lexically bound in %s here but declared dynamic in: %s"
+ var context
+ (mapconcat #'identity
+ (mapcan (lambda (v) (and (eq var (car v))
+ (list (cdr v))))
+ byte-compile--known-dynamic-vars)
+ ", "))))
(defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
"Byte-compile a lambda-expression and return a valid function.
@@ -2900,6 +2904,10 @@ for symbols generated by the byte compiler itself."
(if (cdr body)
(setq body (cdr body))))))
(int (assq 'interactive body)))
+ (when lexical-binding
+ (dolist (var arglistvars)
+ (when (assq var byte-compile--known-dynamic-vars)
+ (byte-compile--warn-lexical-dynamic var 'lambda))))
;; Process the interactive spec.
(when int
(byte-compile-set-symbol-position 'interactive)
@@ -3215,7 +3223,8 @@ for symbols generated by the byte compiler itself."
(t "."))))
(if (eq (car-safe (symbol-function (car form))) 'macro)
(byte-compile-report-error
- (format "Forgot to expand macro %s in %S" (car form) form)))
+ (format "`%s' defined after use in %S (missing `require' of a library file?)"
+ (car form) form)))
(if (and handler
;; Make sure that function exists.
(and (functionp handler)
@@ -3463,7 +3472,7 @@ for symbols generated by the byte compiler itself."
(if (equal-including-properties (car elt) ,const)
(setq result elt)))
result)
- (assq ,const byte-compile-constants))
+ (assoc ,const byte-compile-constants #'eql))
(car (setq byte-compile-constants
(cons (list ,const) byte-compile-constants)))))
@@ -3491,7 +3500,7 @@ the opcode to be used. If function is a list, the first element
is the function and the second element is the bytecode-symbol.
The second element may be nil, meaning there is no opcode.
COMPILE-HANDLER is the function to use to compile this byte-op, or
-may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
+may be the abbreviations 0, 1, 2, 2-and, 3, 0-1, 1-2, 1-3, or 2-3.
If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(let (opcode)
(if (symbolp function)
@@ -3510,6 +3519,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(0-1 . byte-compile-zero-or-one-arg)
(1-2 . byte-compile-one-or-two-args)
(2-3 . byte-compile-two-or-three-args)
+ (1-3 . byte-compile-one-to-three-args)
)))
compile-handler
(intern (concat "byte-compile-"
@@ -3620,10 +3630,10 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(byte-defop-compiler (% byte-rem) 2)
(byte-defop-compiler aset 3)
-(byte-defop-compiler max byte-compile-associative)
-(byte-defop-compiler min byte-compile-associative)
-(byte-defop-compiler (+ byte-plus) byte-compile-associative)
-(byte-defop-compiler (* byte-mult) byte-compile-associative)
+(byte-defop-compiler max byte-compile-min-max)
+(byte-defop-compiler min byte-compile-min-max)
+(byte-defop-compiler (+ byte-plus) byte-compile-variadic-numeric)
+(byte-defop-compiler (* byte-mult) byte-compile-variadic-numeric)
;;####(byte-defop-compiler move-to-column 1)
(byte-defop-compiler-1 interactive byte-compile-noop)
@@ -3694,6 +3704,13 @@ These implicitly `and' together a bunch of two-arg bytecodes."
((= len 4) (byte-compile-three-args form))
(t (byte-compile-subr-wrong-args form "2-3")))))
+(defun byte-compile-one-to-three-args (form)
+ (let ((len (length form)))
+ (cond ((= len 2) (byte-compile-three-args (append form '(nil nil))))
+ ((= len 3) (byte-compile-three-args (append form '(nil))))
+ ((= len 4) (byte-compile-three-args form))
+ (t (byte-compile-subr-wrong-args form "1-3")))))
+
(defun byte-compile-noop (_form)
(byte-compile-constant nil))
@@ -3763,30 +3780,36 @@ discarding."
(if byte-compile--for-effect (setq byte-compile--for-effect nil)
(byte-compile-out 'byte-constant (nth 1 form))))
-;; Compile a function that accepts one or more args and is right-associative.
-;; We do it by left-associativity so that the operations
-;; are done in the same order as in interpreted code.
-;; We treat the one-arg case, as in (+ x), like (+ x 0).
-;; in order to convert markers to numbers, and trigger expected errors.
-(defun byte-compile-associative (form)
+;; Compile a pure function that accepts zero or more numeric arguments
+;; and has an opcode for the binary case.
+;; Single-argument calls are assumed to be numeric identity and are
+;; compiled as (* x 1) in order to convert markers to numbers and
+;; trigger type errors.
+(defun byte-compile-variadic-numeric (form)
+ (pcase (length form)
+ (1
+ ;; No args: use the identity value for the operation.
+ (byte-compile-constant (eval form)))
+ (2
+ ;; One arg: compile (OP x) as (* x 1). This is identity for
+ ;; all numerical values including -0.0, infinities and NaNs.
+ (byte-compile-form (nth 1 form))
+ (byte-compile-constant 1)
+ (byte-compile-out (get '* 'byte-opcode) 0))
+ (3
+ (byte-compile-form (nth 1 form))
+ (byte-compile-form (nth 2 form))
+ (byte-compile-out (get (car form) 'byte-opcode) 0))
+ (_
+ ;; >2 args: compile as a single function call.
+ (byte-compile-normal-call form))))
+
+(defun byte-compile-min-max (form)
+ "Byte-compile calls to `min' or `max'."
(if (cdr form)
- (let ((opcode (get (car form) 'byte-opcode))
- args)
- (if (and (< 3 (length form))
- (memq opcode (list (get '+ 'byte-opcode)
- (get '* 'byte-opcode))))
- ;; Don't use binary operations for > 2 operands, as that
- ;; may cause overflow/truncation in float operations.
- (byte-compile-normal-call form)
- (setq args (copy-sequence (cdr form)))
- (byte-compile-form (car args))
- (setq args (cdr args))
- (or args (setq args '(0)
- opcode (get '+ 'byte-opcode)))
- (dolist (arg args)
- (byte-compile-form arg)
- (byte-compile-out opcode 0))))
- (byte-compile-constant (eval form))))
+ (byte-compile-variadic-numeric form)
+ ;; No args: warn and emit code that raises an error when executed.
+ (byte-compile-normal-call form)))
;; more complicated compiler macros
@@ -3801,7 +3824,7 @@ discarding."
(byte-defop-compiler indent-to)
(byte-defop-compiler insert)
(byte-defop-compiler-1 function byte-compile-function-form)
-(byte-defop-compiler-1 - byte-compile-minus)
+(byte-defop-compiler (- byte-diff) byte-compile-minus)
(byte-defop-compiler (/ byte-quo) byte-compile-quo)
(byte-defop-compiler nconc)
@@ -3868,30 +3891,17 @@ discarding."
((byte-compile-normal-call form)))))
(defun byte-compile-minus (form)
- (let ((len (length form)))
- (cond
- ((= 1 len) (byte-compile-constant 0))
- ((= 2 len)
- (byte-compile-form (cadr form))
- (byte-compile-out 'byte-negate 0))
- ((= 3 len)
- (byte-compile-form (nth 1 form))
- (byte-compile-form (nth 2 form))
- (byte-compile-out 'byte-diff 0))
- ;; Don't use binary operations for > 2 operands, as that may
- ;; cause overflow/truncation in float operations.
- (t (byte-compile-normal-call form)))))
+ (if (/= (length form) 2)
+ (byte-compile-variadic-numeric form)
+ (byte-compile-form (cadr form))
+ (byte-compile-out 'byte-negate 0)))
(defun byte-compile-quo (form)
- (let ((len (length form)))
- (cond ((< len 2)
- (byte-compile-subr-wrong-args form "1 or more"))
- ((= len 3)
- (byte-compile-two-args form))
- (t
- ;; Don't use binary operations for > 2 operands, as that
- ;; may cause overflow/truncation in float operations.
- (byte-compile-normal-call form)))))
+ (if (= (length form) 3)
+ (byte-compile-two-args form)
+ ;; N-ary `/' is not the left-reduction of binary `/' because if any
+ ;; argument is a float, then everything is done in floating-point.
+ (byte-compile-normal-call form)))
(defun byte-compile-nconc (form)
(let ((len (length form)))
@@ -4418,6 +4428,8 @@ Return non-nil if the TOS value was popped."
;; VAR is a simple stack-allocated lexical variable.
(progn (push (assq var init-lexenv)
byte-compile--lexical-environment)
+ (when (assq var byte-compile--known-dynamic-vars)
+ (byte-compile--warn-lexical-dynamic var 'let))
nil)
;; VAR should be dynamically bound.
(while (assq var byte-compile--lexical-environment)
@@ -4534,96 +4546,25 @@ binding slots have been popped."
;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro.
;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro.
-(defvar byte-compile--use-old-handlers nil
- "If nil, use new byte codes introduced in Emacs-24.4.")
-
(defun byte-compile-catch (form)
(byte-compile-form (car (cdr form)))
- (if (not byte-compile--use-old-handlers)
- (let ((endtag (byte-compile-make-tag)))
- (byte-compile-goto 'byte-pushcatch endtag)
- (byte-compile-body (cddr form) nil)
- (byte-compile-out 'byte-pophandler)
- (byte-compile-out-tag endtag))
- (pcase (cddr form)
- (`(:fun-body ,f)
- (byte-compile-form `(list 'funcall ,f)))
- (body
- (byte-compile-push-constant
- (byte-compile-top-level (cons 'progn body) byte-compile--for-effect))))
- (byte-compile-out 'byte-catch 0)))
+ (let ((endtag (byte-compile-make-tag)))
+ (byte-compile-goto 'byte-pushcatch endtag)
+ (byte-compile-body (cddr form) nil)
+ (byte-compile-out 'byte-pophandler)
+ (byte-compile-out-tag endtag)))
(defun byte-compile-unwind-protect (form)
(pcase (cddr form)
(`(:fun-body ,f)
- (byte-compile-form
- (if byte-compile--use-old-handlers `(list (list 'funcall ,f)) f)))
+ (byte-compile-form f))
(handlers
- (if byte-compile--use-old-handlers
- (byte-compile-push-constant
- (byte-compile-top-level-body handlers t))
- (byte-compile-form `#'(lambda () ,@handlers)))))
+ (byte-compile-form `#'(lambda () ,@handlers))))
(byte-compile-out 'byte-unwind-protect 0)
(byte-compile-form-do-effect (car (cdr form)))
(byte-compile-out 'byte-unbind 1))
(defun byte-compile-condition-case (form)
- (if byte-compile--use-old-handlers
- (byte-compile-condition-case--old form)
- (byte-compile-condition-case--new form)))
-
-(defun byte-compile-condition-case--old (form)
- (let* ((var (nth 1 form))
- (fun-bodies (eq var :fun-body))
- (byte-compile-bound-variables
- (if (and var (not fun-bodies))
- (cons var byte-compile-bound-variables)
- byte-compile-bound-variables)))
- (byte-compile-set-symbol-position 'condition-case)
- (unless (symbolp var)
- (byte-compile-warn
- "`%s' is not a variable-name or nil (in condition-case)" var))
- (if fun-bodies (setq var (make-symbol "err")))
- (byte-compile-push-constant var)
- (if fun-bodies
- (byte-compile-form `(list 'funcall ,(nth 2 form)))
- (byte-compile-push-constant
- (byte-compile-top-level (nth 2 form) byte-compile--for-effect)))
- (let ((compiled-clauses
- (mapcar
- (lambda (clause)
- (let ((condition (car clause)))
- (cond ((not (or (symbolp condition)
- (and (listp condition)
- (let ((ok t))
- (dolist (sym condition)
- (if (not (symbolp sym))
- (setq ok nil)))
- ok))))
- (byte-compile-warn
- "`%S' is not a condition name or list of such (in condition-case)"
- condition))
- ;; (not (or (eq condition 't)
- ;; (and (stringp (get condition 'error-message))
- ;; (consp (get condition
- ;; 'error-conditions)))))
- ;; (byte-compile-warn
- ;; "`%s' is not a known condition name
- ;; (in condition-case)"
- ;; condition))
- )
- (if fun-bodies
- `(list ',condition (list 'funcall ,(cadr clause) ',var))
- (cons condition
- (byte-compile-top-level-body
- (cdr clause) byte-compile--for-effect)))))
- (cdr (cdr (cdr form))))))
- (if fun-bodies
- (byte-compile-form `(list ,@compiled-clauses))
- (byte-compile-push-constant compiled-clauses)))
- (byte-compile-out 'byte-condition-case 0)))
-
-(defun byte-compile-condition-case--new (form)
(let* ((var (nth 1 form))
(body (nth 2 form))
(depth byte-compile-depth)
@@ -4861,6 +4802,14 @@ binding slots have been popped."
(defun byte-compile-form-make-variable-buffer-local (form)
(byte-compile-keep-pending form 'byte-compile-normal-call))
+;; Make `make-local-variable' declare the variable locally
+;; dynamic - this suppresses some unnecessary warnings
+(byte-defop-compiler-1 make-local-variable
+ byte-compile-make-local-variable)
+(defun byte-compile-make-local-variable (form)
+ (pcase form (`(,_ ',var) (byte-compile--declare-var var)))
+ (byte-compile-normal-call form))
+
(put 'function-put 'byte-hunk-handler 'byte-compile-define-symbol-prop)
(put 'define-symbol-prop 'byte-hunk-handler 'byte-compile-define-symbol-prop)
(defun byte-compile-define-symbol-prop (form)
@@ -5309,6 +5258,8 @@ and corresponding effects."
byte-compile-variable-ref))))
nil)
+(make-obsolete-variable 'bytecomp-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'bytecomp-load-hook)
;;; bytecomp.el ends here
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e2e59337d7b..351a097ad19 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -462,20 +462,7 @@ places where they originally did not directly appear."
;; and may be an invalid expression (e.g. ($# . 678)).
(cdr forms)))))
- ;condition-case
- ((and `(condition-case ,var ,protected-form . ,handlers)
- (guard byte-compile--use-old-handlers))
- (let ((newform (cconv--convert-function
- () (list protected-form) env form)))
- `(condition-case :fun-body ,newform
- ,@(mapcar (lambda (handler)
- (list (car handler)
- (cconv--convert-function
- (list (or var cconv--dummy-var))
- (cdr handler) env form)))
- handlers))))
-
- ; condition-case with new byte-codes.
+ ; condition-case
(`(condition-case ,var ,protected-form . ,handlers)
`(condition-case ,var
,(cconv-convert protected-form env extend)
@@ -496,10 +483,8 @@ places where they originally did not directly appear."
`((let ((,var (list ,var))) ,@body))))))
handlers))))
- (`(,(and head (or (and 'catch (guard byte-compile--use-old-handlers))
- 'unwind-protect))
- ,form . ,body)
- `(,head ,(cconv-convert form env extend)
+ (`(unwind-protect ,form . ,body)
+ `(unwind-protect ,(cconv-convert form env extend)
:fun-body ,(cconv--convert-function () body env form)))
(`(setq . ,forms) ; setq special form
@@ -718,15 +703,6 @@ and updates the data stored in ENV."
(`(quote . ,_) nil) ; quote form
(`(function . ,_) nil) ; same as quote
- ((and `(condition-case ,var ,protected-form . ,handlers)
- (guard byte-compile--use-old-handlers))
- ;; FIXME: The bytecode for condition-case forces us to wrap the
- ;; form and handlers in closures.
- (cconv--analyze-function () (list protected-form) env form)
- (dolist (handler handlers)
- (cconv--analyze-function (if var (list var)) (cdr handler)
- env form)))
-
(`(condition-case ,var ,protected-form . ,handlers)
(cconv-analyze-form protected-form env)
(when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
@@ -741,9 +717,7 @@ and updates the data stored in ENV."
form "variable"))))
;; FIXME: The bytecode for unwind-protect forces us to wrap the unwind.
- (`(,(or (and 'catch (guard byte-compile--use-old-handlers))
- 'unwind-protect)
- ,form . ,body)
+ (`(unwind-protect ,form . ,body)
(cconv-analyze-form form env)
(cconv--analyze-function () body env form))
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 2321ac1ed50..177710038a0 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -4,7 +4,7 @@
;; Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.2
+;; Old-Version: 0.2
;; Keywords: OO, chart, graph
;; This file is part of GNU Emacs.
@@ -105,9 +105,7 @@ Useful if new Emacs is used on B&W display.")
(car cl)
"white"))
(set-face-foreground nf "black")
- (if (and chart-face-use-pixmaps
- pl
- (fboundp 'set-face-background-pixmap))
+ (if (and chart-face-use-pixmaps pl)
(condition-case nil
(set-face-background-pixmap nf (car pl))
(error (message "Cannot set background pixmap %s" (car pl)))))
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index 144385ea27c..208214f2e6e 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -1,8 +1,9 @@
-;;; check-declare.el --- Check declare-function statements
+;;; check-declare.el --- Check declare-function statements -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, tools, maint
;; This file is part of GNU Emacs.
@@ -248,7 +249,7 @@ TYPE is a string giving the nature of the error.
Optional LINE is the claim's line number; otherwise, search for the claim.
Display warning in `check-declare-warning-buffer'."
(let ((warning-prefix-function
- (lambda (level entry)
+ (lambda (_level entry)
(insert (format "%s:%d:" (file-relative-name file) (or line 0)))
entry))
(warning-fill-prefix " "))
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 797493743c0..61384c0e6fa 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -3,7 +3,7 @@
;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.6.2
+;; Old-Version: 0.6.2
;; Keywords: docs, maint, lisp
;; This file is part of GNU Emacs.
@@ -37,7 +37,6 @@
;; documentation whenever you evaluate Lisp code with C-M-x
;; or [menu-bar emacs-lisp eval-buffer]. Additional key-bindings
;; are also provided under C-c ? KEY
-;; (require 'checkdoc)
;; (add-hook 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
;;
;; Using `checkdoc':
@@ -170,6 +169,7 @@
;;; Code:
(defvar checkdoc-version "0.6.2"
"Release version of checkdoc you are currently running.")
+(make-obsolete-variable 'checkdoc-version nil "28.1")
(require 'cl-lib)
(require 'help-mode) ;; for help-xref-info-regexp
@@ -1248,13 +1248,8 @@ checking of documentation strings.
;;; Subst utils
;;
-(defsubst checkdoc-run-hooks (hookvar &rest args)
- "Run hooks in HOOKVAR with ARGS."
- (if (fboundp 'run-hook-with-args-until-success)
- (apply #'run-hook-with-args-until-success hookvar args)
- ;; This method was similar to above. We ignore the warning
- ;; since we will use the above for future Emacs versions
- (apply #'run-hook-with-args hookvar args)))
+(define-obsolete-function-alias 'checkdoc-run-hooks
+ #'run-hook-with-args-until-success "28.1")
(defsubst checkdoc-create-common-verbs-regexp ()
"Rebuild the contents of `checkdoc-common-verbs-regexp'."
@@ -1577,7 +1572,8 @@ mouse-[0-3]\\)\\)\\>"))
;; a prefix.
(let ((disambiguate
(completing-read
- "Disambiguating Keyword (default variable): "
+ (format-prompt "Disambiguating Keyword"
+ "variable")
'(("function") ("command") ("variable")
("option") ("symbol"))
nil t nil nil "variable")))
@@ -1872,7 +1868,7 @@ Replace with \"%s\"? " original replace)
;; and reliance on the Ispell program.
(checkdoc-ispell-docstring-engine e take-notes)
;; User supplied checks
- (save-excursion (checkdoc-run-hooks 'checkdoc-style-functions fp e))
+ (save-excursion (run-hook-with-args-until-success 'checkdoc-style-functions fp e))
;; Done!
)))
@@ -2383,7 +2379,7 @@ Code:, and others referenced in the style guide."
err
(or
;; Generic Full-file checks (should be comment related)
- (checkdoc-run-hooks 'checkdoc-comment-style-functions)
+ (run-hook-with-args-until-success 'checkdoc-comment-style-functions)
err))
;; Done with full file comment checks
err)))
@@ -2592,7 +2588,7 @@ This function will not modify `match-data'."
;; going on.
(if checkdoc-bouncy-flag (message "%s -> done" question))
(delete-region start end)
- (insert replacewith)
+ (insert-before-markers replacewith)
(if checkdoc-bouncy-flag (sit-for 0))
(setq ret t)))
(delete-overlay o)
@@ -2642,7 +2638,7 @@ function called to create the messages."
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert "\n\n\C-l\n*** " label ": "
- check-type " V " checkdoc-version)))))
+ check-type)))))
(defun checkdoc-error (point msg)
"Store POINT and MSG as errors in the checkdoc diagnostic buffer."
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index ce6fb625bc0..d3159a37683 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -72,8 +72,7 @@ strings case-insensitively."
(cond ((eq x y) t)
((stringp x)
(and (stringp y) (= (length x) (length y))
- (or (string-equal x y)
- (string-equal (downcase x) (downcase y))))) ;Lazy but simple!
+ (eq (compare-strings x nil nil y nil nil t) t)))
((numberp x)
(and (numberp y) (= x y)))
((consp x)
@@ -202,8 +201,11 @@ the elements themselves.
;;;###autoload
(defun cl-some (cl-pred cl-seq &rest cl-rest)
- "Return true if PREDICATE is true of any element of SEQ or SEQs.
-If so, return the true (non-nil) value returned by PREDICATE.
+ "Say whether PREDICATE is true for any element in the SEQ sequences.
+More specifically, the return value of this function will be the
+same as the first return value of PREDICATE where PREDICATE has a
+non-nil value.
+
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq))
(catch 'cl-some
@@ -553,10 +555,9 @@ too large if positive or too small if negative)."
(seq-subseq seq start end))
;;;###autoload
-(defun cl-concatenate (type &rest sequences)
+(defalias 'cl-concatenate #'seq-concatenate
"Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
-\n(fn TYPE SEQUENCE...)"
- (apply #'seq-concatenate type sequences))
+\n(fn TYPE SEQUENCE...)")
;;; List functions.
@@ -912,6 +913,8 @@ Outputs to the current buffer."
(mapc #'cl--describe-class-slot cslots))))
+(make-obsolete-variable 'cl-extra-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'cl-extra-load-hook)
;; Local variables:
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 4e8423eb5b1..02da07daaf4 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -211,7 +211,16 @@ DEFAULT-BODY, if present, is used as the body of a default method.
[&rest [&or
("declare" &rest sexp)
(":argument-precedence-order" &rest sexp)
- (&define ":method" [&rest atom]
+ (&define ":method"
+ ;; FIXME: The `:unique'
+ ;; construct works around
+ ;; Bug#42672. We'd rather want
+ ;; names like those generated by
+ ;; `cl-defmethod', but that
+ ;; requires larger changes to
+ ;; Edebug.
+ :unique "cl-generic-:method@"
+ [&rest cl-generic-method-qualifier]
cl-generic-method-args lambda-doc
def-body)]]
def-body)))
@@ -432,9 +441,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
(&define ; this means we are defining something
[&or name ("setf" name :name setf)]
;; ^^ This is the methods symbol
- [ &rest atom ] ; Multiple qualifiers are allowed.
- ; Like in CLOS spec, we support
- ; any non-list values.
+ [ &rest cl-generic-method-qualifier ]
+ ;; Multiple qualifiers are allowed.
cl-generic-method-args ; arguments
lambda-doc ; documentation string
def-body))) ; part to be debugged
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index fd8715962a3..66502da668a 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -46,14 +46,12 @@
"Maximum depth to backtrack out from a sublist for structured indentation.
If this variable is 0, no backtracking will occur and forms such as `flet'
may not be correctly indented."
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-tag-indentation 1
"Indentation of tags relative to containing list.
This variable is used by the function `lisp-indent-tagbody'."
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-tag-body-indentation 3
"Indentation of non-tagged lines relative to containing list.
@@ -64,32 +62,30 @@ the special form. If the value is t, the body of tags will be indented
as a block at the same indentation as the first s-expression following
the tag. In this case, any forms before the first tag are indented
by `lisp-body-indent'."
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-backquote-indentation t
"Whether or not to indent backquoted lists as code.
If nil, indent backquoted lists as data, i.e., like quoted lists."
- :type 'boolean
- :group 'lisp-indent)
+ :type 'boolean)
-(defcustom lisp-loop-keyword-indentation 3
+(defcustom lisp-loop-keyword-indentation 6
"Indentation of loop keywords in extended loop forms."
:type 'integer
- :group 'lisp-indent)
+ :version "28.1")
-(defcustom lisp-loop-forms-indentation 5
+(defcustom lisp-loop-forms-indentation 6
"Indentation of forms in extended loop forms."
:type 'integer
- :group 'lisp-indent)
+ :version "28.1")
-(defcustom lisp-simple-loop-indentation 3
+(defcustom lisp-simple-loop-indentation 1
"Indentation of forms in simple loop forms."
:type 'integer
- :group 'lisp-indent)
+ :version "28.1")
(defcustom lisp-lambda-list-keyword-alignment nil
"Whether to vertically align lambda-list keywords together.
@@ -107,16 +103,14 @@ If non-nil, alignment is done with the first keyword
&key key1 key2)
#|...|#)"
:version "24.1"
- :type 'boolean
- :group 'lisp-indent)
+ :type 'boolean)
(defcustom lisp-lambda-list-keyword-parameter-indentation 2
"Indentation of lambda list keyword parameters.
See `lisp-lambda-list-keyword-parameter-alignment'
for more information."
:version "24.1"
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-lambda-list-keyword-parameter-alignment nil
"Whether to vertically align lambda-list keyword parameters together.
@@ -135,8 +129,7 @@ If non-nil, alignment is done with the first parameter
key3 key4)
#|...|#)"
:version "24.1"
- :type 'boolean
- :group 'lisp-indent)
+ :type 'boolean)
(defcustom lisp-indent-backquote-substitution-mode t
"How to indent substitutions in backquotes.
@@ -148,8 +141,7 @@ In any case, do not backtrack beyond a backquote substitution.
Until Emacs 25.1, the nil behavior was hard-wired."
:version "25.1"
- :type '(choice (const corrected) (const nil) (const t))
- :group 'lisp-indent)
+ :type '(choice (const corrected) (const nil) (const t)))
(defvar lisp-indent-defun-method '(4 &lambda &body)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 7a26d9a90fd..86ee94e87e0 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -619,8 +619,11 @@ If ALIST is non-nil, the new pairs are prepended to it."
(macroexp-let2* nil ((start from) (end to))
(funcall do `(substring ,getter ,start ,end)
(lambda (v)
- (funcall setter `(cl--set-substring
- ,getter ,start ,end ,v))))))))
+ (macroexp-let2 nil v v
+ `(progn
+ ,(funcall setter `(cl--set-substring
+ ,getter ,start ,end ,v))
+ ,v))))))))
;;; Miscellaneous.
@@ -660,6 +663,7 @@ This can be needed when using code byte-compiled using the old
macro-expansion of `cl-defstruct' that used vectors objects instead
of record objects."
:global t
+ :group 'tools
(cond
(cl-old-struct-compat-mode
(advice-add 'type-of :around #'cl--old-struct-type-of))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 78d083fcc63..1501ed43082 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -75,7 +75,7 @@
;; one, you may want to amend the other, too.
;;;###autoload
(define-obsolete-function-alias 'cl--compiler-macro-cXXr
- 'internal--compiler-macro-cXXr "25.1")
+ #'internal--compiler-macro-cXXr "25.1")
;;; Some predicates for analyzing Lisp forms.
;; These are used by various
@@ -199,7 +199,7 @@ The name is made by appending a number to PREFIX, default \"T\"."
[&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
&optional "&allow-other-keys"]]
[&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
+ &or (cl-lambda-arg &optional def-form) arg]]
. [&or arg nil])))
(def-edebug-spec cl-&optional-arg
@@ -219,7 +219,7 @@ The name is made by appending a number to PREFIX, default \"T\"."
[&optional ["&key" cl-&key-arg &rest cl-&key-arg
&optional "&allow-other-keys"]]
[&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
+ &or (cl-lambda-arg &optional def-form) arg]]
. [&or arg nil])))
(def-edebug-spec cl-type-spec sexp)
@@ -328,8 +328,7 @@ FORM is of the form (ARGS . BODY)."
(setq cl--bind-lets (nreverse cl--bind-lets))
;; (cl-assert (eq :dummy (nth 1 (car cl--bind-lets))))
(list '&rest (car (pop cl--bind-lets))))))))
- `(nil
- (,@(nreverse simple-args) ,@rest-args)
+ `((,@(nreverse simple-args) ,@rest-args)
,@header
,(macroexp-let* cl--bind-lets
(macroexp-progn
@@ -366,9 +365,7 @@ more details.
def-body))
(doc-string 3)
(indent 2))
- (let* ((res (cl--transform-lambda (cons args body) name))
- (form `(defun ,name ,@(cdr res))))
- (if (car res) `(progn ,(car res) ,form) form)))
+ `(defun ,name ,@(cl--transform-lambda (cons args body) name)))
;;;###autoload
(defmacro cl-iter-defun (name args &rest body)
@@ -387,9 +384,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
(doc-string 3)
(indent 2))
(require 'generator)
- (let* ((res (cl--transform-lambda (cons args body) name))
- (form `(iter-defun ,name ,@(cdr res))))
- (if (car res) `(progn ,(car res) ,form) form)))
+ `(iter-defun ,name ,@(cl--transform-lambda (cons args body) name)))
;; The lambda list for macros is different from that of normal lambdas.
;; Note that &environment is only allowed as first or last items in the
@@ -407,7 +402,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
arg]]
&optional "&allow-other-keys"]]
[&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
+ &or (cl-macro-arg &optional def-form) arg]]
[&optional "&environment" arg]
)))
@@ -426,7 +421,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
arg]]
&optional "&allow-other-keys"]]
[&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
+ &or (cl-macro-arg &optional def-form) arg]]
. [&or arg nil])))
;;;###autoload
@@ -455,9 +450,7 @@ more details.
(&define name cl-macro-list cl-declarations-or-string def-body))
(doc-string 3)
(indent 2))
- (let* ((res (cl--transform-lambda (cons args body) name))
- (form `(defmacro ,name ,@(cdr res))))
- (if (car res) `(progn ,(car res) ,form) form)))
+ `(defmacro ,name ,@(cl--transform-lambda (cons args body) name)))
(def-edebug-spec cl-lambda-expr
(&define ("lambda" cl-lambda-list
@@ -480,9 +473,7 @@ Like normal `function', except that if argument is a lambda form,
its argument list allows full Common Lisp conventions."
(declare (debug (&or symbolp cl-lambda-expr)))
(if (eq (car-safe func) 'lambda)
- (let* ((res (cl--transform-lambda (cdr func) 'cl-none))
- (form `(function (lambda . ,(cdr res)))))
- (if (car res) `(progn ,(car res) ,form) form))
+ `(function (lambda . ,(cl--transform-lambda (cdr func) 'cl-none)))
`(function ,func)))
(defun cl--make-usage-var (x)
@@ -723,9 +714,9 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
(let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
(cl--not-toplevel t))
(if (or (memq 'load when) (memq :load-toplevel when))
- (if comp (cons 'progn (mapcar 'cl--compile-time-too body))
+ (if comp (cons 'progn (mapcar #'cl--compile-time-too body))
`(if nil nil ,@body))
- (progn (if comp (eval (cons 'progn body))) nil)))
+ (progn (if comp (eval (cons 'progn body) lexical-binding)) nil)))
(and (or (memq 'eval when) (memq :execute when))
(cons 'progn body))))
@@ -734,13 +725,13 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
(setq form (macroexpand
form (cons '(cl-eval-when) byte-compile-macro-environment))))
(cond ((eq (car-safe form) 'progn)
- (cons 'progn (mapcar 'cl--compile-time-too (cdr form))))
+ (cons 'progn (mapcar #'cl--compile-time-too (cdr form))))
((eq (car-safe form) 'cl-eval-when)
(let ((when (nth 1 form)))
(if (or (memq 'eval when) (memq :execute when))
`(cl-eval-when (compile ,@when) ,@(cddr form))
form)))
- (t (eval form) form)))
+ (t (eval form lexical-binding) form)))
;;;###autoload
(defmacro cl-load-time-value (form &optional _read-only)
@@ -766,7 +757,7 @@ The result of the body appears to the compiler as a quoted constant."
;; temp is set before we use it.
(print set byte-compile--outbuffer))
temp)
- `',(eval form)))
+ `',(eval form lexical-binding)))
;;; Conditional control structures.
@@ -889,7 +880,7 @@ This is compatible with Common Lisp, but note that `defun' and
;;; The "cl-loop" macro.
(defvar cl--loop-args) (defvar cl--loop-accum-var) (defvar cl--loop-accum-vars)
-(defvar cl--loop-bindings) (defvar cl--loop-body)
+(defvar cl--loop-bindings) (defvar cl--loop-body) (defvar cl--loop-conditions)
(defvar cl--loop-finally)
(defvar cl--loop-finish-flag) ;Symbol set to nil to exit the loop?
(defvar cl--loop-first-flag)
@@ -966,7 +957,8 @@ For more details, see Info node `(cl)Loop Facility'.
(cl--loop-accum-var nil) (cl--loop-accum-vars nil)
(cl--loop-initially nil) (cl--loop-finally nil)
(cl--loop-iterator-function nil) (cl--loop-first-flag nil)
- (cl--loop-symbol-macs nil))
+ (cl--loop-symbol-macs nil)
+ (cl--loop-conditions nil))
;; Here is more or less how those dynbind vars are used after looping
;; over cl--parse-loop-clause:
;;
@@ -1034,6 +1026,13 @@ For more details, see Info node `(cl)Loop Facility'.
(list `(cl-symbol-macrolet ,cl--loop-symbol-macs ,@body))))
`(cl-block ,cl--loop-name ,@body)))))
+(defmacro cl--push-clause-loop-body (clause)
+ "Apply CLAUSE to both `cl--loop-conditions' and `cl--loop-body'."
+ (macroexp-let2 nil sym clause
+ `(progn
+ (push ,sym cl--loop-conditions)
+ (push ,sym cl--loop-body))))
+
;; Below is a complete spec for cl-loop, in several parts that correspond
;; to the syntax given in CLtL2. The specs do more than specify where
;; the forms are; it also specifies, as much as Edebug allows, all the
@@ -1184,8 +1183,6 @@ For more details, see Info node `(cl)Loop Facility'.
;; (def-edebug-spec loop-d-type-spec
;; (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
-
-
(defun cl--parse-loop-clause () ; uses loop-*
(let ((word (pop cl--loop-args))
(hash-types '(hash-key hash-keys hash-value hash-values))
@@ -1264,11 +1261,11 @@ For more details, see Info node `(cl)Loop Facility'.
(if end-var (push (list end-var end) loop-for-bindings))
(if step-var (push (list step-var step)
loop-for-bindings))
- (if end
- (push (list
- (if down (if excl '> '>=) (if excl '< '<=))
- var (or end-var end))
- cl--loop-body))
+ (when end
+ (cl--push-clause-loop-body
+ (list
+ (if down (if excl '> '>=) (if excl '< '<=))
+ var (or end-var end))))
(push (list var (list (if down '- '+) var
(or step-var step 1)))
loop-for-steps)))
@@ -1278,7 +1275,7 @@ For more details, see Info node `(cl)Loop Facility'.
(temp (if (and on (symbolp var))
var (make-symbol "--cl-var--"))))
(push (list temp (pop cl--loop-args)) loop-for-bindings)
- (push `(consp ,temp) cl--loop-body)
+ (cl--push-clause-loop-body `(consp ,temp))
(if (eq word 'in-ref)
(push (list var `(car ,temp)) cl--loop-symbol-macs)
(or (eq temp var)
@@ -1301,33 +1298,31 @@ For more details, see Info node `(cl)Loop Facility'.
((eq word '=)
(let* ((start (pop cl--loop-args))
(then (if (eq (car cl--loop-args) 'then)
- (cl--pop2 cl--loop-args) start)))
+ (cl--pop2 cl--loop-args) start))
+ (first-assign (or cl--loop-first-flag
+ (setq cl--loop-first-flag
+ (make-symbol "--cl-var--")))))
(push (list var nil) loop-for-bindings)
(if (or ands (eq (car cl--loop-args) 'and))
(progn
- (push `(,var
- (if ,(or cl--loop-first-flag
- (setq cl--loop-first-flag
- (make-symbol "--cl-var--")))
- ,start ,var))
- loop-for-sets)
- (push (list var then) loop-for-steps))
- (push (list var
- (if (eq start then) start
- `(if ,(or cl--loop-first-flag
- (setq cl--loop-first-flag
- (make-symbol "--cl-var--")))
- ,start ,then)))
- loop-for-sets))))
+ (push `(,var (if ,first-assign ,start ,var)) loop-for-sets)
+ (push `(,var (if ,(car (cl--loop-build-ands
+ (nreverse cl--loop-conditions)))
+ ,then ,var))
+ loop-for-steps))
+ (push (if (eq start then)
+ `(,var ,then)
+ `(,var (if ,first-assign ,start ,then)))
+ loop-for-sets))))
((memq word '(across across-ref))
(let ((temp-vec (make-symbol "--cl-vec--"))
(temp-idx (make-symbol "--cl-idx--")))
(push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
(push (list temp-idx -1) loop-for-bindings)
- (push `(< (setq ,temp-idx (1+ ,temp-idx))
- (length ,temp-vec))
- cl--loop-body)
+ (push `(setq ,temp-idx (1+ ,temp-idx)) cl--loop-body)
+ (cl--push-clause-loop-body
+ `(< ,temp-idx (length ,temp-vec)))
(if (eq word 'across-ref)
(push (list var `(aref ,temp-vec ,temp-idx))
cl--loop-symbol-macs)
@@ -1351,17 +1346,16 @@ For more details, see Info node `(cl)Loop Facility'.
(push (list temp-seq seq) loop-for-bindings)
(push (list temp-idx 0) loop-for-bindings)
(if ref
- (let ((temp-len (make-symbol "--cl-len--")))
+ (let ((temp-len (make-symbol "--cl-len--")))
(push (list temp-len `(length ,temp-seq))
loop-for-bindings)
(push (list var `(elt ,temp-seq ,temp-idx))
cl--loop-symbol-macs)
- (push `(< ,temp-idx ,temp-len) cl--loop-body))
+ (cl--push-clause-loop-body `(< ,temp-idx ,temp-len)))
(push (list var nil) loop-for-bindings)
- (push `(and ,temp-seq
- (or (consp ,temp-seq)
- (< ,temp-idx (length ,temp-seq))))
- cl--loop-body)
+ (cl--push-clause-loop-body `(and ,temp-seq
+ (or (consp ,temp-seq)
+ (< ,temp-idx (length ,temp-seq)))))
(push (list var `(if (consp ,temp-seq)
(pop ,temp-seq)
(aref ,temp-seq ,temp-idx)))
@@ -1457,9 +1451,8 @@ For more details, see Info node `(cl)Loop Facility'.
(push (list var '(selected-frame))
loop-for-bindings)
(push (list temp nil) loop-for-bindings)
- (push `(prog1 (not (eq ,var ,temp))
- (or ,temp (setq ,temp ,var)))
- cl--loop-body)
+ (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp))
+ (or ,temp (setq ,temp ,var))))
(push (list var `(next-frame ,var))
loop-for-steps)))
@@ -1480,9 +1473,8 @@ For more details, see Info node `(cl)Loop Facility'.
(push (list minip `(minibufferp (window-buffer ,var)))
loop-for-bindings)
(push (list temp nil) loop-for-bindings)
- (push `(prog1 (not (eq ,var ,temp))
- (or ,temp (setq ,temp ,var)))
- cl--loop-body)
+ (cl--push-clause-loop-body `(prog1 (not (eq ,var ,temp))
+ (or ,temp (setq ,temp ,var))))
(push (list var `(next-window ,var ,minip))
loop-for-steps)))
@@ -1498,17 +1490,17 @@ For more details, see Info node `(cl)Loop Facility'.
(pop cl--loop-args))
(if (and ands loop-for-bindings)
(push (nreverse loop-for-bindings) cl--loop-bindings)
- (setq cl--loop-bindings (nconc (mapcar 'list loop-for-bindings)
- cl--loop-bindings)))
+ (setq cl--loop-bindings (nconc (mapcar #'list loop-for-bindings)
+ cl--loop-bindings)))
(if loop-for-sets
(push `(progn
,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
t)
cl--loop-body))
- (if loop-for-steps
- (push (cons (if ands 'cl-psetq 'setq)
- (apply 'append (nreverse loop-for-steps)))
- cl--loop-steps))))
+ (when loop-for-steps
+ (push (cons (if ands 'cl-psetq 'setq)
+ (apply #'append (nreverse loop-for-steps)))
+ cl--loop-steps))))
((eq word 'repeat)
(let ((temp (make-symbol "--cl-var--")))
@@ -1700,7 +1692,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings."
(push binding new))))
(if (eq body 'setq)
(let ((set (cons (if par 'cl-psetq 'setq)
- (apply 'nconc (nreverse new)))))
+ (apply #'nconc (nreverse new)))))
(if temps `(let* ,(nreverse temps) ,set) set))
`(,(if par 'let 'let*)
,(nconc (nreverse temps) (nreverse new)) ,@body))))
@@ -1826,7 +1818,7 @@ For more details, see `cl-do*' description in Info node `(cl) Iteration'.
(and sets
(list (cons (if (or star (not (cdr sets)))
'setq 'cl-psetq)
- (apply 'append sets))))))
+ (apply #'append sets))))))
,@(or (cdr endtest) '(nil)))))
;;;###autoload
@@ -2024,7 +2016,12 @@ info node `(cl) Function Bindings' for details.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1)
- (debug ((&rest [&or (&define name function-form) (cl-defun)])
+ (debug ((&rest [&or (&define name :unique "cl-flet@" function-form)
+ (&define name :unique "cl-flet@"
+ cl-lambda-list
+ cl-declarations-or-string
+ [&optional ("interactive" interactive)]
+ def-body)])
cl-declarations body)))
(let ((binds ()) (newenv macroexpand-all-environment))
(dolist (binding bindings)
@@ -2105,10 +2102,9 @@ This is like `cl-flet', but for macros instead of functions.
(if (null bindings) (macroexp-progn body)
(let* ((name (caar bindings))
(res (cl--transform-lambda (cdar bindings) name)))
- (eval (car res))
(macroexpand-all (macroexp-progn body)
(cons (cons name
- (eval `(cl-function (lambda ,@(cdr res))) t))
+ (eval `(function (lambda ,@res)) t))
macroexpand-all-environment))))))
(defun cl--sm-macroexpand (orig-fun exp &optional env)
@@ -2472,7 +2468,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
\(fn PLACE...)"
(declare (debug (&rest place)))
- (if (not (memq nil (mapcar 'symbolp args)))
+ (if (not (memq nil (mapcar #'symbolp args)))
(and (cdr args)
(let ((sets nil)
(first (car args)))
@@ -2872,7 +2868,9 @@ Supported keywords for slots are:
(append pred-form '(t))
`(and ,pred-form t)))
forms)
- (push `(put ',name 'cl-deftype-satisfies ',predicate) forms))
+ (push `(eval-and-compile
+ (put ',name 'cl-deftype-satisfies ',predicate))
+ forms))
(let ((pos 0) (descp descs))
(while descp
(let* ((desc (pop descp))
@@ -2971,15 +2969,27 @@ Supported keywords for slots are:
constrs))
(pcase-dolist (`(,cname ,args ,doc) constrs)
(let* ((anames (cl--arglist-args args))
- (make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d)))
- slots defaults)))
- (push `(,cldefsym ,cname
+ (make (cl-mapcar (lambda (s d) (if (memq s anames) s d))
+ slots defaults))
+ ;; `cl-defsubst' is fundamentally broken: it substitutes
+ ;; its arguments into the body's `sexp' much too naively
+ ;; when inlinling, which results in various problems.
+ ;; For example it generates broken code if your
+ ;; argument's name happens to be the same as some
+ ;; function used within the body.
+ ;; E.g. (cl-defsubst sm-foo (list) (list list))
+ ;; will expand `(sm-foo 1)' to `(1 1)' rather than to `(list t)'!
+ ;; Try to catch this known case!
+ (con-fun (or type #'record))
+ (unsafe-cl-defsubst
+ (or (memq con-fun args) (assq con-fun args))))
+ (push `(,(if unsafe-cl-defsubst 'cl-defun cldefsym) ,cname
(&cl-defs (nil ,@descs) ,@args)
,(if (stringp doc) doc
(format "Constructor for objects of type `%s'." name))
,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
'((declare (side-effect-free t))))
- (,(or type #'record) ,@make))
+ (,con-fun ,@make))
forms)))
(if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
;; Don't bother adding to cl-custom-print-functions since it's not used
@@ -3132,13 +3142,35 @@ Of course, we really can't know that for sure, so it's just a heuristic."
(or (cdr (assq sym byte-compile-function-environment))
(cdr (assq sym byte-compile-macro-environment))))))
-(put 'null 'cl-deftype-satisfies #'null)
-(put 'atom 'cl-deftype-satisfies #'atom)
-(put 'real 'cl-deftype-satisfies #'numberp)
-(put 'fixnum 'cl-deftype-satisfies #'integerp)
-(put 'base-char 'cl-deftype-satisfies #'characterp)
-(put 'character 'cl-deftype-satisfies #'natnump)
-
+(pcase-dolist (`(,type . ,pred)
+ ;; Mostly kept in alphabetical order.
+ '((array . arrayp)
+ (atom . atom)
+ (base-char . characterp)
+ (boolean . booleanp)
+ (bool-vector . bool-vector-p)
+ (buffer . bufferp)
+ (character . natnump)
+ (char-table . char-table-p)
+ (hash-table . hash-table-p)
+ (cons . consp)
+ (fixnum . integerp)
+ (float . floatp)
+ (function . functionp)
+ (integer . integerp)
+ (keyword . keywordp)
+ (list . listp)
+ (number . numberp)
+ (null . null)
+ (real . numberp)
+ (sequence . sequencep)
+ (string . stringp)
+ (symbol . symbolp)
+ (vector . vectorp)
+ ;; FIXME: Do we really want to consider this a type?
+ (integer-or-marker . integer-or-marker-p)
+ ))
+ (put type 'cl-deftype-satisfies pred))
;;;###autoload
(define-inline cl-typep (val type)
@@ -3207,7 +3239,10 @@ STRING is an optional description of the desired type."
(macroexp-let2 macroexp-copyable-p temp form
`(progn (or (cl-typep ,temp ',type)
(signal 'wrong-type-argument
- (list ,(or string `',type) ,temp ',form)))
+ (list ,(or string `',(if (eq 'satisfies
+ (car-safe type))
+ (cadr type) type))
+ ,temp ',form)))
nil))))
;;;###autoload
@@ -3395,6 +3430,8 @@ STRUCT and SLOT-NAME are symbols. INST is a structure instance."
(nth (cl-struct-slot-offset ,struct-type ,slot-name) ,inst)
(aref ,inst (cl-struct-slot-offset ,struct-type ,slot-name)))))))
+(make-obsolete-variable 'cl-macs-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'cl-macs-load-hook)
;; Local variables:
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index f90cce9b471..d34d50172df 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -1042,6 +1042,8 @@ Atoms are compared by `eql'; cons cells are compared recursively.
(and (not (consp cl-x)) (not (consp cl-y)) (cl--check-match cl-x cl-y)))
+(make-obsolete-variable 'cl-seq-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'cl-seq-load-hook)
;; Local variables:
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index 6fa51c3f644..9828ca63ebc 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -1,4 +1,4 @@
-;;; copyright.el --- update the copyright notice in current buffer
+;;; copyright.el --- update the copyright notice in current buffer -*- lexical-binding: t -*-
;; Copyright (C) 1991-1995, 1998, 2001-2020 Free Software Foundation,
;; Inc.
@@ -37,14 +37,12 @@
(defcustom copyright-limit 2000
"Don't try to update copyright beyond this position unless interactive.
A value of nil means to search whole buffer."
- :group 'copyright
:type '(choice (integer :tag "Limit")
(const :tag "No limit")))
(defcustom copyright-at-end-flag nil
"Non-nil means to search backwards from the end of the buffer for copyright.
This is useful for ChangeLogs."
- :group 'copyright
:type 'boolean
:version "23.1")
;;;###autoload(put 'copyright-at-end-flag 'safe-local-variable 'booleanp)
@@ -56,7 +54,6 @@ This is useful for ChangeLogs."
\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
"What your copyright notice looks like.
The second \\( \\) construct must match the years."
- :group 'copyright
:type 'regexp)
(defcustom copyright-names-regexp ""
@@ -64,7 +61,6 @@ The second \\( \\) construct must match the years."
Only copyright lines where the name matches this regexp will be updated.
This allows you to avoid adding years to a copyright notice belonging to
someone else or to a group for which you do not work."
- :group 'copyright
:type 'regexp)
;; The worst that can happen is a malicious regexp that overflows in
@@ -76,7 +72,6 @@ someone else or to a group for which you do not work."
"\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
"Match additional copyright notice years.
The second \\( \\) construct must match the years."
- :group 'copyright
:type 'regexp)
;; See "Copyright Notices" in maintain.info.
@@ -87,7 +82,6 @@ The second \\( \\) construct must match the years."
For example: 2005, 2006, 2007, 2008 might be replaced with 2005-2008.
If you use ranges, you should add an explanatory note in a README file.
The function `copyright-fix-years' respects this variable."
- :group 'copyright
:type 'boolean
:version "24.1")
@@ -96,7 +90,6 @@ The function `copyright-fix-years' respects this variable."
(defcustom copyright-query 'function
"If non-nil, ask user before changing copyright.
When this is `function', only ask when called non-interactively."
- :group 'copyright
:type '(choice (const :tag "Do not ask")
(const :tag "Ask unless interactive" function)
(other :tag "Ask" t)))
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 65483d0813a..89d106ee489 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -270,12 +270,6 @@ with empty strings removed."
(remove-hook 'choose-completion-string-functions
'crm--choose-completion-string)))
-(define-obsolete-function-alias 'crm-minibuffer-complete 'crm-complete "23.1")
-(define-obsolete-function-alias
- 'crm-minibuffer-completion-help 'crm-completion-help "23.1")
-(define-obsolete-function-alias
- 'crm-minibuffer-complete-and-exit 'crm-complete-and-exit "23.1")
-
;; testing and debugging
;; (defun crm-init-test-environ ()
;; "Set up some variables for testing."
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 8cd0bdef648..0e4135b253e 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -670,9 +670,7 @@ Redefining FUNCTION also cancels it."
(when (special-form-p fn)
(setq fn nil))
(setq val (completing-read
- (if fn
- (format "Debug on entry to function (default %s): " fn)
- "Debug on entry to function: ")
+ (format-prompt "Debug on entry to function" fn)
obarray
#'(lambda (symbol)
(and (fboundp symbol)
@@ -775,8 +773,7 @@ another symbol also cancels it."
(let* ((var-at-point (variable-at-point))
(var (and (symbolp var-at-point) var-at-point))
(val (completing-read
- (concat "Debug when setting variable"
- (if var (format " (default %s): " var) ": "))
+ (format-prompt "Debug when setting variable" var)
obarray #'boundp
t nil nil (and var (symbol-name var)))))
(list (if (equal val "") var (intern val)))))
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 3eafad177dd..6a11f1c3949 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -364,6 +364,7 @@ which more-or-less shadow%s %s's corresponding table%s."
(defsubst derived-mode-setup-function-name (mode)
"Construct a setup-function name based on a MODE name."
+ (declare (obsolete nil "28.1"))
(intern (concat (symbol-name mode) "-setup")))
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 51b7db24f3c..c2faac8085b 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -57,10 +57,9 @@ If OBJECT is not already compiled, we compile it, but do not
redefine OBJECT if it is a symbol."
(interactive
(let* ((fn (function-called-at-point))
- (prompt (if fn (format "Disassemble function (default %s): " fn)
- "Disassemble function: "))
(def (and fn (symbol-name fn))))
- (list (intern (completing-read prompt obarray 'fboundp t nil nil def))
+ (list (intern (completing-read (format-prompt "Disassemble function" fn)
+ obarray 'fboundp t nil nil def))
nil 0 t)))
(if (and (consp object) (not (functionp object)))
(setq object `(lambda () ,object)))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index ad4f2d6c9eb..261f2508af7 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -1,4 +1,4 @@
-;;; easy-mmode.el --- easy definition for major and minor modes
+;;; easy-mmode.el --- easy definition for major and minor modes -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2000-2020 Free Software Foundation, Inc.
@@ -84,10 +84,16 @@ replacing its case-insensitive matches with the literal string in LIGHTER."
(defconst easy-mmode--arg-docstring
"
-If called interactively, enable %s if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp,
-also enable the mode if ARG is omitted or nil, and toggle it
-if ARG is `toggle'; disable the mode otherwise.")
+If called interactively, toggle `%s'. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.")
(defun easy-mmode--mode-docstring (doc mode-pretty-name keymap-sym)
(let ((doc (or doc (format "Toggle %s on or off.
@@ -158,9 +164,6 @@ BODY contains code to execute each time the mode is enabled or disabled.
the minor mode is global):
:group GROUP Custom group name to use in all generated `defcustom' forms.
- Defaults to MODE without the possible trailing \"-mode\".
- Don't use this default group name unless you have written a
- `defgroup' to define that group properly.
:global GLOBAL If non-nil specifies that the minor mode is not meant to be
buffer-local, so don't make the variable MODE buffer-local.
By default, the mode is buffer-local.
@@ -263,12 +266,6 @@ For example, you could write
(unless initialize
(setq initialize '(:initialize 'custom-initialize-default)))
- (unless group
- ;; We might as well provide a best-guess default group.
- (setq group
- `(:group ',(intern (replace-regexp-in-string
- "-mode\\'" "" mode-name)))))
-
;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode.
(unless type (setq type '(:type 'boolean)))
@@ -307,13 +304,18 @@ or call the function `%s'."))))
,(easy-mmode--mode-docstring doc pretty-name keymap-sym)
;; Use `toggle' rather than (if ,mode 0 1) so that using
;; repeat-command still does the toggling correctly.
- (interactive (list (or current-prefix-arg 'toggle)))
+ (interactive (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 'toggle)))
(let ((,last-message (current-message)))
(,@setter
- (if (eq arg 'toggle)
- (not ,getter)
- ;; A nil argument also means ON now.
- (> (prefix-numeric-value arg) 0)))
+ (cond ((eq arg 'toggle)
+ (not ,getter))
+ ((and (numberp arg)
+ (< arg 1))
+ nil)
+ (t
+ t)))
,@body
;; The on/off hooks are here for backward compatibility only.
(run-hooks ',hook (if ,getter ',hook-on ',hook-off))
@@ -345,6 +347,9 @@ or call the function `%s'."))))
No problems result if this variable is not bound.
`add-hook' automatically binds it. (This is true for all hook variables.)"
modefun)))
+ ;; Allow using using `M-x customize-variable' on the hook.
+ (put ',hook 'custom-type 'hook)
+ (put ',hook 'standard-value (list nil))
;; Define the minor-mode keymap.
,(unless (symbolp keymap) ;nil is also a symbol.
@@ -378,18 +383,21 @@ No problems result if this variable is not bound.
(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest body)
"Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
TURN-ON is a function that will be called with no args in every buffer
- and that should try to turn MODE on if applicable for that buffer.
-Each of KEY VALUE is a pair of CL-style keyword arguments. As
- the minor mode defined by this function is always global, any
- :global keyword is ignored. Other keywords have the same
- meaning as in `define-minor-mode', which see. In particular,
- :group specifies the custom group. The most useful keywords
- are those that are passed on to the `defcustom'. It normally
- makes no sense to pass the :lighter or :keymap keywords to
- `define-globalized-minor-mode', since these are usually passed
- to the buffer-local version of the minor mode.
+and that should try to turn MODE on if applicable for that buffer.
+
+Each of KEY VALUE is a pair of CL-style keyword arguments. :predicate
+specifies which major modes the globalized minor mode should be switched on
+in. As the minor mode defined by this function is always global, any
+:global keyword is ignored. Other keywords have the same meaning as in
+`define-minor-mode', which see. In particular, :group specifies the custom
+group. The most useful keywords are those that are passed on to the
+`defcustom'. It normally makes no sense to pass the :lighter or :keymap
+keywords to `define-globalized-minor-mode', since these are usually passed
+to the buffer-local version of the minor mode.
+
BODY contains code to execute each time the mode is enabled or disabled.
- It is executed after toggling the mode, and before running GLOBAL-MODE-hook.
+It is executed after toggling the mode, and before running
+GLOBAL-MODE-hook.
If MODE's set-up depends on the major mode in effect when it was
enabled, then disabling and reenabling MODE should make MODE work
@@ -418,7 +426,11 @@ on if the hook has explicitly disabled it.
(minor-MODE-hook (intern (concat mode-name "-hook")))
(MODE-set-explicitly (intern (concat mode-name "-set-explicitly")))
(MODE-major-mode (intern (concat (symbol-name mode) "-major-mode")))
- keyw)
+ (MODE-predicate (intern (concat (replace-regexp-in-string
+ "-mode\\'" "" global-mode-name)
+ "-modes")))
+ (turn-on-function `#',turn-on)
+ keyw predicate)
;; Check keys.
(while (keywordp (setq keyw (car body)))
@@ -426,6 +438,13 @@ on if the hook has explicitly disabled it.
(pcase keyw
(:group (setq group (nconc group (list :group (pop body)))))
(:global (pop body))
+ (:predicate
+ (setq predicate (list (pop body)))
+ (setq turn-on-function
+ `(lambda ()
+ (require 'easy-mmode)
+ (when (easy-mmode--globalized-predicate-p ,(car predicate))
+ (funcall ,turn-on-function)))))
(_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
`(progn
@@ -445,10 +464,17 @@ ARG is omitted or nil.
%s is enabled in all buffers where
`%s' would do it.
-See `%s' for more information on %s."
+
+See `%s' for more information on
+%s.%s"
pretty-name pretty-global-name
- pretty-name turn-on mode pretty-name)
- :global t ,@group ,@(nreverse extra-keywords)
+ pretty-name turn-on mode pretty-name
+ (if predicate
+ (format "\n\n`%s' is used to control which modes
+this minor mode is used in."
+ MODE-predicate)
+ ""))
+ :global t ,@group ,@(nreverse extra-keywords)
;; Setup hook to handle future mode changes and new buffers.
(if ,global-mode
@@ -464,9 +490,28 @@ See `%s' for more information on %s."
;; Go through existing buffers.
(dolist (buf (buffer-list))
(with-current-buffer buf
- (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1)))))
+ (if ,global-mode (funcall ,turn-on-function)
+ (when ,mode (,mode -1)))))
,@body)
+ ,(when predicate
+ `(defcustom ,MODE-predicate ,(car predicate)
+ ,(format "Which major modes `%s' is switched on in.
+This variable can be either t (all major modes), nil (no major modes),
+or a list of modes and (not modes) to switch use this minor mode or
+not. For instance
+
+ (c-mode (not message-mode mail-mode) text-mode)
+
+means \"use this mode in all modes derived from `c-mode', don't use in
+modes derived from `message-mode' or `mail-mode', but do use in other
+modes derived from `text-mode'\". An element with value t means \"use\"
+and nil means \"don't use\". There's an implicit nil at the end of the
+list."
+ mode)
+ :type '(repeat sexp)
+ :group ,group))
+
;; Autoloading define-globalized-minor-mode autoloads everything
;; up-to-here.
:autoload-end
@@ -500,8 +545,8 @@ See `%s' for more information on %s."
(if ,mode
(progn
(,mode -1)
- (funcall #',turn-on))
- (funcall #',turn-on))))
+ (funcall ,turn-on-function))
+ (funcall ,turn-on-function))))
(setq ,MODE-major-mode major-mode))))))
(put ',MODE-enable-in-buffers 'definition-name ',global-mode)
@@ -516,6 +561,33 @@ See `%s' for more information on %s."
(add-hook 'post-command-hook ',MODE-check-buffers))
(put ',MODE-cmhh 'definition-name ',global-mode))))
+(defun easy-mmode--globalized-predicate-p (predicate)
+ (cond
+ ((eq predicate t)
+ t)
+ ((eq predicate nil)
+ nil)
+ ((listp predicate)
+ ;; Legacy support for (not a b c).
+ (when (eq (car predicate) 'not)
+ (setq predicate (nconc (mapcar (lambda (e) (list 'not e))
+ (cdr predicate))
+ (list t))))
+ (catch 'found
+ (dolist (elem predicate)
+ (cond
+ ((eq elem t)
+ (throw 'found t))
+ ((eq elem nil)
+ (throw 'found nil))
+ ((and (consp elem)
+ (eq (car elem) 'not))
+ (when (apply #'derived-mode-p (cdr elem))
+ (throw 'found nil)))
+ ((symbolp elem)
+ (when (derived-mode-p elem)
+ (throw 'found t)))))))))
+
;;;
;;; easy-mmode-defmap
;;;
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 6ba8b997f84..73dabef3fa5 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -29,16 +29,6 @@
;;; Code:
-(defvar easy-menu-precalculate-equivalent-keybindings nil
- "Determine when equivalent key bindings are computed for easy-menu menus.
-It can take some time to calculate the equivalent key bindings that are shown
-in a menu. If the variable is on, then this calculation gives a (maybe
-noticeable) delay when a mode is first entered. If the variable is off, then
-this delay will come when a menu is displayed the first time. If you never use
-menus, turn this variable off, otherwise it is probably better to keep it on.")
-(make-obsolete-variable
- 'easy-menu-precalculate-equivalent-keybindings nil "23.1")
-
(defsubst easy-menu-intern (s)
(if (stringp s) (intern s) s))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index a0bc6562bc9..e310313940f 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -555,7 +555,7 @@ already is one.)"
;; Compatibility with old versions.
-(defalias 'edebug-all-defuns 'edebug-all-defs)
+(define-obsolete-function-alias 'edebug-all-defuns #'edebug-all-defs "28.1")
;;;###autoload
(defun edebug-all-defs ()
@@ -741,6 +741,21 @@ Maybe clear the markers and delete the symbol's edebug property?"
;;; Offsets for reader
+(defun edebug-get-edebug-or-ghost (name)
+ "Get NAME's value of property `edebug' or property `ghost-edebug'.
+
+The idea is that should function NAME be recompiled whilst
+debugging is in progress, property `edebug' will get set to a
+marker. The needed data will then come from property
+`ghost-edebug'."
+ (let ((e (get name 'edebug)))
+ (if (consp e)
+ e
+ (let ((g (get name 'ghost-edebug)))
+ (if (consp g)
+ g
+ e)))))
+
;; Define a structure to represent offset positions of expressions.
;; Each offset structure looks like: (before . after) for constituents,
;; or for structures that have elements: (before <subexpressions> . after)
@@ -1168,6 +1183,12 @@ purpose by adding an entry to this alist, and setting
;; Not edebugging this form, so reset the symbol's edebug
;; property to be just a marker at the definition's source code.
;; This only works for defs with simple names.
+
+ ;; Preserve the `edebug' property in case there's
+ ;; debugging still under way.
+ (let ((ghost (get def-name 'edebug)))
+ (if (consp ghost)
+ (put def-name 'ghost-edebug ghost)))
(put def-name 'edebug (point-marker))
;; Also nil out dependent defs.
'(mapcar (function
@@ -1208,7 +1229,7 @@ purpose by adding an entry to this alist, and setting
"Wrap the FORMS of a definition body."
(if edebug-def-interactive
`(let ((,(edebug-interactive-p-name)
- (interactive-p)))
+ (called-interactively-p 'interactive)))
,(edebug-make-enter-wrapper forms))
(edebug-make-enter-wrapper forms)))
@@ -1219,6 +1240,13 @@ purpose by adding an entry to this alist, and setting
;; since it wraps the list of forms with a call to `edebug-enter'.
;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
;; Do this after parsing since that may find a name.
+ (when (string-match-p (rx bos "edebug-anon" (+ digit) eos)
+ (symbol-name edebug-old-def-name))
+ ;; FIXME: Due to Bug#42701, we reset an anonymous name so that
+ ;; backtracking doesn't generate duplicate definitions. It would
+ ;; be better to not define wrappers in the case of a non-matching
+ ;; specification branch to begin with.
+ (setq edebug-old-def-name nil))
(setq edebug-def-name
(or edebug-def-name edebug-old-def-name (gensym "edebug-anon")))
`(edebug-enter
@@ -1411,6 +1439,8 @@ contains a circular object."
(cons window (window-start window)))))
;; Store the edebug data in symbol's property list.
+ ;; We actually want to remove this property entirely, but can't.
+ (put edebug-def-name 'ghost-edebug nil)
(put edebug-def-name 'edebug
;; A struct or vector would be better here!!
(list edebug-form-begin-marker
@@ -1423,8 +1453,8 @@ contains a circular object."
)))
(defun edebug--restore-breakpoints (name)
- (let ((data (get name 'edebug)))
- (when (listp data)
+ (let ((data (edebug-get-edebug-or-ghost name)))
+ (when (consp data)
(let ((offsets (nth 2 data))
(breakpoints (nth 1 data))
(start (nth 0 data))
@@ -1702,18 +1732,22 @@ contains a circular object."
(&define . edebug-match-&define)
(name . edebug-match-name)
(:name . edebug-match-colon-name)
+ (:unique . edebug-match-:unique)
(arg . edebug-match-arg)
(def-body . edebug-match-def-body)
(def-form . edebug-match-def-form)
;; Less frequently used:
;; (function . edebug-match-function)
(lambda-expr . edebug-match-lambda-expr)
+ (cl-generic-method-qualifier
+ . edebug-match-cl-generic-method-qualifier)
(cl-generic-method-args . edebug-match-cl-generic-method-args)
(cl-macrolet-expr . edebug-match-cl-macrolet-expr)
(cl-macrolet-name . edebug-match-cl-macrolet-name)
(cl-macrolet-body . edebug-match-cl-macrolet-body)
(&not . edebug-match-&not)
(&key . edebug-match-&key)
+ (&error . edebug-match-&error)
(place . edebug-match-place)
(gate . edebug-match-gate)
;; (nil . edebug-match-nil) not this one - special case it.
@@ -1832,9 +1866,6 @@ contains a circular object."
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-
-(def-edebug-spec &key edebug-match-&key)
-
(defun edebug-match-&key (cursor specs)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
@@ -1847,6 +1878,15 @@ contains a circular object."
(car (cdr pair))))
specs))))
+(defun edebug-match-&error (cursor specs)
+ ;; Signal an error, using the following string in the spec as argument.
+ (let ((error-string (car specs))
+ (edebug-error-point (edebug-before-offset cursor)))
+ (goto-char edebug-error-point)
+ (error "%s"
+ (if (stringp error-string)
+ error-string
+ "String expected after &error in edebug-spec"))))
(defun edebug-match-gate (_cursor)
;; Simply set the gate to prevent backtracking at this level.
@@ -2005,6 +2045,27 @@ contains a circular object."
spec))
nil)
+(defun edebug-match-:unique (_cursor spec)
+ "Match a `:unique PREFIX' specifier.
+SPEC is the symbol name prefix for `gensym'."
+ (let ((suffix (gensym spec)))
+ (setq edebug-def-name
+ (if edebug-def-name
+ ;; Construct a new name by appending to previous name.
+ (intern (format "%s@%s" edebug-def-name suffix))
+ suffix)))
+ nil)
+
+(defun edebug-match-cl-generic-method-qualifier (cursor)
+ "Match a QUALIFIER for `cl-defmethod' at CURSOR."
+ (let ((args (edebug-top-element-required cursor "Expected qualifier")))
+ ;; Like in CLOS spec, we support any non-list values.
+ (unless (atom args) (edebug-no-match cursor "Atom expected"))
+ ;; Append the arguments to `edebug-def-name' (Bug#42671).
+ (setq edebug-def-name (intern (format "%s %s" edebug-def-name args)))
+ (edebug-move-cursor cursor)
+ (list args)))
+
(defun edebug-match-cl-generic-method-args (cursor)
(let ((args (edebug-top-element-required cursor "Expected arguments")))
(if (not (consp args))
@@ -2105,10 +2166,10 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
(def-edebug-spec edebug-spec
(&or
+ edebug-spec-list
(vector &rest edebug-spec) ; matches a vector
("vector" &rest edebug-spec) ; matches a vector spec
("quote" symbolp)
- edebug-spec-list
stringp
[edebug-lambda-list-keywordp &rest edebug-spec]
[keywordp gate edebug-spec]
@@ -2216,6 +2277,8 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
(def-edebug-spec nested-backquote-form
(&or
+ ("`" &error "Triply nested backquotes (without commas \"between\" them) \
+are too difficult to instrument")
;; Allow instrumentation of any , or ,@ contained within the (\, ...) or
;; (\,@ ...) matched on the next line.
([&or "," ",@"] backquote-form)
@@ -2602,9 +2665,6 @@ See `edebug-behavior-alist' for implementations.")
(defvar edebug-previous-result nil) ;; Last result returned.
-;; Emacs 19 adds an arg to mark and mark-marker.
-(defalias 'edebug-mark-marker 'mark-marker)
-
(defun edebug--display (value offset-index arg-mode)
;; edebug--display-1 is too big, we should split it. This function
;; here was just introduced to avoid making edebug--display-1
@@ -2755,6 +2815,7 @@ See `edebug-behavior-alist' for implementations.")
(edebug-stop))
(edebug-overlay-arrow)
+ (edebug--overlay-breakpoints edebug-function)
(unwind-protect
(if (or edebug-stop
@@ -2831,9 +2892,8 @@ See `edebug-behavior-alist' for implementations.")
;; But don't restore point if edebug-buffer is current buffer.
(if (not (eq edebug-buffer edebug-outside-buffer))
(goto-char edebug-outside-point))
- (if (marker-buffer (edebug-mark-marker))
- ;; Does zmacs-regions need to be nil while doing set-marker?
- (set-marker (edebug-mark-marker) edebug-outside-mark))
+ (if (marker-buffer (mark-marker))
+ (set-marker (mark-marker) edebug-outside-mark))
)) ; unwind-protect
;; None of the following is done if quit or signal occurs.
@@ -2844,6 +2904,7 @@ See `edebug-behavior-alist' for implementations.")
(goto-char edebug-buffer-outside-point))
;; ... nothing more.
)
+ (edebug--overlay-breakpoints-remove (point-min) (point-max))
;; Could be an option to keep eval display up.
(if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
(with-timeout-unsuspend edebug-with-timeout-suspend)
@@ -3089,8 +3150,8 @@ before returning. The default is one second."
(goto-char edebug-outside-point)
(message "Current buffer: %s Point: %s Mark: %s"
(current-buffer) (point)
- (if (marker-buffer (edebug-mark-marker))
- (marker-position (edebug-mark-marker)) "<not set>"))
+ (if (marker-buffer (mark-marker))
+ (marker-position (mark-marker)) "<not set>"))
(sit-for arg)
(edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
@@ -3118,7 +3179,7 @@ before returning. The default is one second."
;; Return (function . index) of the nearest edebug stop point.
(let* ((edebug-def-name (edebug-form-data-symbol))
(edebug-data
- (let ((data (get edebug-def-name 'edebug)))
+ (let ((data (edebug-get-edebug-or-ghost edebug-def-name)))
(if (or (null data) (markerp data))
(error "%s is not instrumented for Edebug" edebug-def-name))
data)) ; we could do it automatically, if data is a marker.
@@ -3155,7 +3216,7 @@ before returning. The default is one second."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
- (edebug-data (get edebug-def-name 'edebug))
+ (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
;; pull out parts of edebug-data
(edebug-def-mark (car edebug-data))
@@ -3196,7 +3257,7 @@ the breakpoint."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
- (edebug-data (get edebug-def-name 'edebug))
+ (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
;; pull out parts of edebug-data
(edebug-def-mark (car edebug-data))
@@ -3228,7 +3289,45 @@ the breakpoint."
(setcar (cdr edebug-data) edebug-breakpoints)
(goto-char position)
- ))))
+ (edebug--overlay-breakpoints edebug-def-name)))))
+
+(define-fringe-bitmap 'edebug-breakpoint
+ "\x3c\x7e\xff\xff\xff\xff\x7e\x3c")
+
+(defun edebug--overlay-breakpoints (function)
+ (let* ((data (edebug-get-edebug-or-ghost function))
+ (start (nth 0 data))
+ (breakpoints (nth 1 data))
+ (offsets (nth 2 data)))
+ ;; First remove all old breakpoint overlays.
+ (edebug--overlay-breakpoints-remove
+ start (+ start (aref offsets (1- (length offsets)))))
+ ;; Then make overlays for the breakpoints (but only when we are in
+ ;; edebug mode).
+ (when edebug-active
+ (dolist (breakpoint breakpoints)
+ (let* ((pos (+ start (aref offsets (car breakpoint))))
+ (overlay (make-overlay pos (1+ pos)))
+ (face (if (nth 4 breakpoint)
+ (progn
+ (overlay-put overlay
+ 'help-echo "Disabled breakpoint")
+ (overlay-put overlay
+ 'face 'edebug-disabled-breakpoint))
+ (overlay-put overlay 'help-echo "Breakpoint")
+ (overlay-put overlay 'face 'edebug-enabled-breakpoint))))
+ (overlay-put overlay 'edebug t)
+ (let ((fringe (make-overlay pos pos)))
+ (overlay-put fringe 'edebug t)
+ (overlay-put fringe 'before-string
+ (propertize
+ "x" 'display
+ `(left-fringe edebug-breakpoint ,face)))))))))
+
+(defun edebug--overlay-breakpoints-remove (start end)
+ (dolist (overlay (overlays-in start end))
+ (when (overlay-get overlay 'edebug)
+ (delete-overlay overlay))))
(defun edebug-set-breakpoint (arg)
"Set the breakpoint of nearest sexp.
@@ -3236,9 +3335,9 @@ With prefix argument, make it a temporary breakpoint."
(interactive "P")
;; If the form hasn't been instrumented yet, do it now.
(when (and (not edebug-active)
- (let ((data (get (edebug--form-data-name
- (edebug-get-form-data-entry (point)))
- 'edebug)))
+ (let ((data (edebug-get-edebug-or-ghost
+ (edebug--form-data-name
+ (edebug-get-form-data-entry (point))))))
(or (null data) (markerp data))))
(edebug-defun))
(edebug-modify-breakpoint t nil arg))
@@ -3252,7 +3351,7 @@ With prefix argument, make it a temporary breakpoint."
"Unset all the breakpoints in the current form."
(interactive)
(let* ((name (edebug-form-data-symbol))
- (breakpoints (nth 1 (get name 'edebug))))
+ (breakpoints (nth 1 (edebug-get-edebug-or-ghost name))))
(unless breakpoints
(user-error "There are no breakpoints in %s" name))
(save-excursion
@@ -3268,12 +3367,13 @@ With prefix argument, make it a temporary breakpoint."
(user-error "No stop point near point"))
(let* ((name (car stop-point))
(index (cdr stop-point))
- (data (get name 'edebug))
+ (data (edebug-get-edebug-or-ghost name))
(breakpoint (assq index (nth 1 data))))
(unless breakpoint
(user-error "No breakpoint near point"))
(setf (nth 4 breakpoint)
- (not (nth 4 breakpoint))))))
+ (not (nth 4 breakpoint)))
+ (edebug--overlay-breakpoints name))))
(defun edebug-set-global-break-condition (expression)
"Set `edebug-global-break-condition' to EXPRESSION."
@@ -3448,7 +3548,7 @@ instrument cannot be found, signal an error."
(goto-char func-marker)
(edebug-eval-top-level-form)
(list func)))
- ((consp func-marker)
+ ((and (consp func-marker) (consp (symbol-function func)))
(message "%s is already instrumented." func)
(list func))
(t
@@ -3622,8 +3722,8 @@ Return the result of the last expression."
;; for us.
(with-current-buffer edebug-outside-buffer ; of edebug-buffer
(goto-char edebug-outside-point)
- (if (marker-buffer (edebug-mark-marker))
- (set-marker (edebug-mark-marker) edebug-outside-mark))
+ (if (marker-buffer (mark-marker))
+ (set-marker (mark-marker) edebug-outside-mark))
,@body)
;; Back to edebug-buffer. Restore rest of inside context.
@@ -3667,7 +3767,6 @@ Return the result of the last expression."
(prin1-to-string edebug-arg))
(cdr value) ", ")))
-(defvar print-readably) ; defined by lemacs
;; Alternatively, we could change the definition of
;; edebug-safe-prin1-to-string to only use these if defined.
@@ -3675,8 +3774,7 @@ Return the result of the last expression."
(let ((print-escape-newlines t)
(print-length (or edebug-print-length print-length))
(print-level (or edebug-print-level print-level))
- (print-circle (or edebug-print-circle print-circle))
- (print-readably nil)) ; lemacs uses this.
+ (print-circle (or edebug-print-circle print-circle)))
(edebug-prin1-to-string value)))
(defun edebug-compute-previous-result (previous-value)
@@ -3920,7 +4018,6 @@ Options:
`edebug-print-circle'
`edebug-on-error'
`edebug-on-quit'
-`edebug-on-signal'
`edebug-unwrap-results'
`edebug-global-break-condition'"
:lighter " *Debugging*"
@@ -4223,7 +4320,7 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME."
(let* ((index (backtrace-get-index))
(frame (nth index backtrace-frames)))
(when (edebug--frame-def-name frame)
- (let* ((data (get (edebug--frame-def-name frame) 'edebug))
+ (let* ((data (edebug-get-edebug-or-ghost (edebug--frame-def-name frame)))
(marker (nth 0 data))
(offsets (nth 2 data)))
(pop-to-buffer (marker-buffer marker))
@@ -4307,7 +4404,7 @@ reinstrument it."
(let* ((function (edebug-form-data-symbol))
(counts (get function 'edebug-freq-count))
(coverages (get function 'edebug-coverage))
- (data (get function 'edebug))
+ (data (edebug-get-edebug-or-ghost function))
(def-mark (car data)) ; mark at def start
(edebug-points (nth 2 data))
(i (1- (length edebug-points)))
@@ -4360,7 +4457,6 @@ reinstrument it."
(defun edebug-temp-display-freq-count ()
"Temporarily display the frequency count data for the current definition.
It is removed when you hit any char."
- ;; This seems not to work with Emacs 18.59. It undoes too far.
(interactive)
(let ((inhibit-read-only t))
(undo-boundary)
@@ -4465,7 +4561,7 @@ With prefix argument, make it a temporary breakpoint."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
- (edebug-data (get edebug-def-name 'edebug))
+ (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
(edebug-breakpoints (car (cdr edebug-data)))
(edebug-break-data (assq index edebug-breakpoints))
(edebug-break-condition (car (cdr edebug-break-data)))
@@ -4479,17 +4575,6 @@ With prefix argument, make it a temporary breakpoint."
(edebug-modify-breakpoint t condition arg))
(easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
-
-;;; Autoloading of Edebug accessories
-
-;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
-(defun edebug--require-cl-read ()
- (require 'edebug-cl-read))
-
-(if (featurep 'cl-read)
- (add-hook 'edebug-setup-hook #'edebug--require-cl-read)
- ;; The following causes edebug-cl-read to be loaded when you load cl-read.el.
- (add-hook 'cl-read-load-hooks #'edebug--require-cl-read))
;;; Finalize Loading
@@ -4525,7 +4610,6 @@ With prefix argument, make it a temporary breakpoint."
(run-with-idle-timer 0 nil #'(lambda () (unload-feature 'edebug)))))
(remove-hook 'called-interactively-p-functions
#'edebug--called-interactively-skip)
- (remove-hook 'cl-read-load-hooks #'edebug--require-cl-read)
(edebug-uninstall-read-eval-functions)
;; Continue standard unloading.
nil)
@@ -4579,5 +4663,7 @@ instrumentation for, defaulting to all functions."
(message "Removed edebug instrumentation from %s"
(mapconcat #'symbol-name functions ", ")))
+(define-obsolete-function-alias 'edebug-mark-marker #'mark-marker "28.1")
+
(provide 'edebug)
;;; edebug.el ends here
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index f6746eb981f..a484c2ff382 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -252,119 +252,87 @@ being pedantic."
(error
"Invalid object: %s is not an object of class %s nor a subclass"
(car ret) class))
- (setq ret (eieio-persistent-convert-list-to-object ret))
+ (setq ret (eieio-persistent-make-instance (car ret) (cdr ret)))
(oset ret file filename))
(kill-buffer " *tmp eieio read*"))
ret))
-(defun eieio-persistent-convert-list-to-object (inputlist)
- "Convert the INPUTLIST, representing object creation to an object.
-While it is possible to just `eval' the INPUTLIST, this code instead
-validates the existing list, and explicitly creates objects instead of
-calling eval. This avoids the possibility of accidentally running
-malicious code.
-
-Note: This function recurses when a slot of :type of some object is
-identified, and needing more object creation."
- (let* ((objclass (nth 0 inputlist))
- ;; Earlier versions of `object-write' added a string name for
- ;; the object, now obsolete.
- (slots (nthcdr
- (if (stringp (nth 1 inputlist)) 2 1)
- inputlist))
- (createslots nil)
- (class
- (progn
- ;; If OBJCLASS is an eieio autoload object, then we need to
- ;; load it.
- (eieio--full-class-object objclass))))
-
- (while slots
- (let ((initarg (car slots))
- (value (car (cdr slots))))
-
- ;; Make sure that the value proposed for SLOT is valid.
- ;; In addition, strip out quotes, list functions, and update
- ;; object constructors as needed.
- (setq value (eieio-persistent-validate/fix-slot-value
- class (eieio--initarg-to-attribute class initarg) value))
-
- (push initarg createslots)
- (push value createslots)
- )
-
- (setq slots (cdr (cdr slots))))
-
- (apply #'make-instance objclass (nreverse createslots))
-
- ;;(eval inputlist)
- ))
-
-(defun eieio-persistent-validate/fix-slot-value (class slot proposed-value)
- "Validate that in CLASS, the SLOT with PROPOSED-VALUE is good, then fix.
-A limited number of functions, such as quote, list, and valid object
-constructor functions are considered valid.
-Second, any text properties will be stripped from strings."
+(cl-defgeneric eieio-persistent-make-instance (objclass inputlist)
+ "Convert INPUTLIST, representing slot values, to an instance of OBJCLASS.
+Clean slot values, and possibly recursively create additional
+objects found there."
+ (:method
+ ((objclass (subclass eieio-default-superclass)) inputlist)
+
+ (let ((slots (if (stringp (car inputlist))
+ ;; Earlier versions of `object-write' added a
+ ;; string name for the object, now obsolete.
+ (cdr inputlist)
+ inputlist))
+ (createslots nil))
+ ;; If OBJCLASS is an eieio autoload object, then we need to
+ ;; load it (we don't need the return value).
+ (eieio--full-class-object objclass)
+ (while slots
+ (let ((initarg (car slots))
+ (value (car (cdr slots))))
+
+ ;; Strip out quotes, list functions, and update object
+ ;; constructors as needed.
+ (setq value (eieio-persistent-fix-value value))
+
+ (push initarg createslots)
+ (push value createslots))
+
+ (setq slots (cdr (cdr slots))))
+
+ (apply #'make-instance objclass (nreverse createslots)))))
+
+(defun eieio-persistent-fix-value (proposed-value)
+ "Fix PROPOSED-VALUE.
+Remove leading quotes from lists, and the symbol `list' from the
+head of lists. Explicitly construct any objects found, and strip
+any text properties from string values.
+
+This function will descend into the contents of lists, hash
+tables, and vectors."
(cond ((consp proposed-value)
;; Lists with something in them need special treatment.
- (let* ((slot-idx (- (eieio--slot-name-index class slot)
- (eval-when-compile eieio--object-num-slots)))
- (type (cl--slot-descriptor-type (aref (eieio--class-slots class)
- slot-idx)))
- (classtype (eieio-persistent-slot-type-is-class-p type)))
-
- (cond ((eq (car proposed-value) 'quote)
- (car (cdr proposed-value)))
-
- ;; An empty list sometimes shows up as (list), which is dumb, but
- ;; we need to support it for backward compat.
- ((and (eq (car proposed-value) 'list)
- (= (length proposed-value) 1))
- nil)
-
- ;; List of object constructors.
- ((and (eq (car proposed-value) 'list)
- ;; 2nd item is a list.
- (consp (car (cdr proposed-value)))
- ;; 1st elt of 2nd item is a class name.
- (class-p (car (car (cdr proposed-value))))
- )
-
- ;; Check the value against the input class type.
- ;; If something goes wrong, issue a smart warning
- ;; about how a :type is needed for this to work.
- (unless (and
- ;; Do we have a type?
- (consp classtype) (class-p (car classtype)))
- (error "In save file, list of object constructors found, but no :type specified for slot %S of type %S"
- slot classtype))
-
- ;; We have a predicate, but it doesn't satisfy the predicate?
- (dolist (PV (cdr proposed-value))
- (unless (child-of-class-p (car PV) (car classtype))
- (error "Invalid object: slot member %s does not match class %s"
- (car PV) (car classtype))))
-
- ;; We have a list of objects here. Lets load them
- ;; in.
- (let ((objlist nil))
- (dolist (subobj (cdr proposed-value))
- (push (eieio-persistent-convert-list-to-object subobj)
- objlist))
- ;; return the list of objects ... reversed.
- (nreverse objlist)))
- ;; We have a slot with a single object that can be
- ;; saved here. Recurse and evaluate that
- ;; sub-object.
- ((and classtype
- (seq-some
- (lambda (elt)
- (child-of-class-p (car proposed-value) elt))
- (if (listp classtype) classtype (list classtype))))
- (eieio-persistent-convert-list-to-object
- proposed-value))
- (t
- proposed-value))))
+ (cond ((eq (car proposed-value) 'quote)
+ (while (eq (car-safe proposed-value) 'quote)
+ (setq proposed-value (car (cdr proposed-value))))
+ proposed-value)
+
+ ;; An empty list sometimes shows up as (list), which is dumb, but
+ ;; we need to support it for backward compar.
+ ((and (eq (car proposed-value) 'list)
+ (= (length proposed-value) 1))
+ nil)
+
+ ;; List of object constructors.
+ ((and (eq (car proposed-value) 'list)
+ ;; 2nd item is a list.
+ (consp (car (cdr proposed-value)))
+ ;; 1st elt of 2nd item is a class name.
+ (class-p (car (car (cdr proposed-value)))))
+
+ ;; We have a list of objects here. Lets load them
+ ;; in.
+ (let ((objlist nil))
+ (dolist (subobj (cdr proposed-value))
+ (push (eieio-persistent-make-instance
+ (car subobj) (cdr subobj))
+ objlist))
+ ;; return the list of objects ... reversed.
+ (nreverse objlist)))
+ ;; We have a slot with a single object that can be
+ ;; saved here. Recurse and evaluate that
+ ;; sub-object.
+ ((class-p (car proposed-value))
+ (eieio-persistent-make-instance
+ (car proposed-value) (cdr proposed-value)))
+ (t
+ proposed-value)))
;; For hash-tables and vectors, the top-level `read' will not
;; "look inside" member values, so we need to do that
;; explicitly. Because `eieio-override-prin1' is recursive in
@@ -375,10 +343,9 @@ Second, any text properties will be stripped from strings."
(lambda (key value)
(setf (gethash key proposed-value)
(if (class-p (car-safe value))
- (eieio-persistent-convert-list-to-object
- value)
- (eieio-persistent-validate/fix-slot-value
- class slot value))))
+ (eieio-persistent-make-instance
+ (car value) (cdr value))
+ (eieio-persistent-fix-value value))))
proposed-value)
proposed-value)
@@ -387,72 +354,18 @@ Second, any text properties will be stripped from strings."
(let ((val (aref proposed-value i)))
(aset proposed-value i
(if (class-p (car-safe val))
- (eieio-persistent-convert-list-to-object
- val)
- (eieio-persistent-validate/fix-slot-value
- class slot val)))))
+ (eieio-persistent-make-instance
+ (car val) (cdr val))
+ (eieio-persistent-fix-value val)))))
proposed-value)
- ((stringp proposed-value)
- ;; Else, check for strings, remove properties.
- (substring-no-properties proposed-value))
-
- (t
- ;; Else, just return whatever the constant was.
- proposed-value))
- )
-
-(defun eieio-persistent-slot-type-is-class-p (type)
- "Return the class referred to in TYPE.
-If no class is referenced there, then return nil."
- (cond ((class-p type)
- ;; If the type is a class, then return it.
- type)
- ((and (eq 'list-of (car-safe type)) (class-p (cadr type)))
- ;; If it is the type of a list of a class, then return that class and
- ;; the type.
- (cons (cadr type) type))
-
- ((and (symbolp type) (get type 'cl-deftype-handler))
- ;; Macro-expand the type according to cl-deftype definitions.
- (eieio-persistent-slot-type-is-class-p
- (funcall (get type 'cl-deftype-handler))))
-
- ;; FIXME: foo-child should not be a valid type!
- ((and (symbolp type) (string-match "-child\\'" (symbol-name type))
- (class-p (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- (unless eieio-backward-compatibility
- (error "Use of bogus %S type instead of %S"
- type (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- ;; If it is the predicate ending with -child, then return
- ;; that class. Unfortunately, in EIEIO, typep of just the
- ;; class is the same as if we used -child, so no further work needed.
- (intern-soft (substring (symbol-name type) 0
- (match-beginning 0))))
- ;; FIXME: foo-list should not be a valid type!
- ((and (symbolp type) (string-match "-list\\'" (symbol-name type))
- (class-p (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- (unless eieio-backward-compatibility
- (error "Use of bogus %S type instead of (list-of %S)"
- type (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))))
- ;; If it is the predicate ending with -list, then return
- ;; that class and the predicate to use.
- (cons (intern-soft (substring (symbol-name type) 0
- (match-beginning 0)))
- type))
-
- ((eq (car-safe type) 'or)
- ;; If type is a list, and is an `or', return all valid class
- ;; types within the `or' statement.
- (seq-filter #'eieio-persistent-slot-type-is-class-p (cdr type)))
+ ((stringp proposed-value)
+ ;; Else, check for strings, remove properties.
+ (substring-no-properties proposed-value))
(t
- ;; No match, not a class.
- nil)))
+ ;; Else, just return whatever the constant was.
+ proposed-value)))
(cl-defmethod object-write ((this eieio-persistent) &optional comment)
"Write persistent object THIS out to the current stream.
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 1e53f30a2ae..3bc65d0d4c5 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -730,7 +730,8 @@ Argument FN is the function calling this verifier."
(guard (not (memq name eieio--known-slot-names))))
(macroexp--warn-and-return
(format-message "Unknown slot `%S'" name) exp 'compile-only))
- (_ exp)))))
+ (_ exp))))
+ (gv-setter eieio-oset))
(cl-check-type slot symbol)
(cl-check-type obj (or eieio-object class))
(let* ((class (cond ((symbolp obj)
@@ -755,6 +756,7 @@ Argument FN is the function calling this verifier."
(defun eieio-oref-default (obj slot)
"Do the work for the macro `oref-default' with similar parameters.
Fills in OBJ's SLOT with its default value."
+ (declare (gv-setter eieio-oset-default))
(cl-check-type obj (or eieio-object class))
(cl-check-type slot symbol)
(let* ((cl (cond ((symbolp obj) (cl--find-class obj))
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index dda90373069..59af7e12d21 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -278,14 +278,7 @@ are not abstract."
(if eieio-class-speedbar-key-map
nil
- (if (not (featurep 'speedbar))
- (add-hook 'speedbar-load-hook (lambda ()
- (eieio-class-speedbar-make-map)
- (speedbar-add-expansion-list
- '("EIEIO"
- eieio-class-speedbar-menu
- eieio-class-speedbar-key-map
- eieio-class-speedbar))))
+ (with-eval-after-load 'speedbar
(eieio-class-speedbar-make-map)
(speedbar-add-expansion-list '("EIEIO"
eieio-class-speedbar-menu
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index c11608da5d8..5c6e0e516d1 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -140,11 +140,7 @@ MENU-VAR is the symbol containing an easymenu compatible menu part to use.
MODENAME is a string used to identify this browser mode.
FETCHER is a generic function used to fetch the base object list used when
creating the speedbar display."
- (if (not (featurep 'speedbar))
- (add-hook 'speedbar-load-hook
- (list 'lambda nil
- (list 'eieio-speedbar-create-engine
- map-fn map-var menu-var modename fetcher)))
+ (with-eval-after-load 'speedbar
(eieio-speedbar-create-engine map-fn map-var menu-var modename fetcher)))
(defun eieio-speedbar-create-engine (map-fn map-var menu-var modename fetcher)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 9f8b639e52d..810affa7227 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -351,24 +351,20 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the
contents of field NAME is matched against PAT, or they can be of
the form NAME which is a shorthand for (NAME NAME)."
(declare (debug (&rest [&or (sexp pcase-PAT) sexp])))
- (let ((is (make-symbol "table")))
- ;; FIXME: This generates a horrendous mess of redundant let bindings.
- ;; `pcase' needs to be improved somehow to introduce let-bindings more
- ;; sparingly, or the byte-compiler needs to be taught to optimize
- ;; them away.
- ;; FIXME: `pcase' does not do a good job here of sharing tests&code among
- ;; various branches.
- `(and (pred eieio-object-p)
- (app eieio-pcase-slot-index-table ,is)
- ,@(mapcar (lambda (field)
- (let* ((name (if (consp field) (car field) field))
- (pat (if (consp field) (cadr field) field))
- (i (make-symbol "index")))
- `(and (let (and ,i (pred natnump))
- (eieio-pcase-slot-index-from-index-table
- ,is ',name))
- (app (pcase--flip aref ,i) ,pat))))
- fields))))
+ ;; FIXME: This generates a horrendous mess of redundant let bindings.
+ ;; `pcase' needs to be improved somehow to introduce let-bindings more
+ ;; sparingly, or the byte-compiler needs to be taught to optimize
+ ;; them away.
+ ;; FIXME: `pcase' does not do a good job here of sharing tests&code among
+ ;; various branches.
+ `(and (pred eieio-object-p)
+ ,@(mapcar (lambda (field)
+ (pcase-exhaustive field
+ (`(,name ,pat)
+ `(app (pcase--flip eieio-oref ',name) ,pat))
+ ((pred symbolp)
+ `(app (pcase--flip eieio-oref ',field) ,field))))
+ fields)))
;;; Simple generators, and query functions. None of these would do
;; well embedded into an object.
@@ -649,14 +645,6 @@ If SLOT is unbound, do nothing."
nil
(eieio-oset object slot (delete item (eieio-oref object slot)))))
-;;; Here are some CLOS items that need the CL package
-;;
-
-;; FIXME: Shouldn't this be a more complex gv-expander which extracts the
-;; common code between oref and oset, so as to reduce the redundant work done
-;; in (push foo (oref bar baz)), like we do for the `nth' expander?
-(gv-define-simple-setter eieio-oref eieio-oset)
-
;;;
;; We want all objects created by EIEIO to have some default set of
@@ -887,7 +875,7 @@ this object."
;; Now output readable lisp to recreate this object
;; It should look like this:
;; (<constructor> <name> <slot> <slot> ... )
- ;; Each slot's slot is writen using its :writer.
+ ;; Each slot's slot is written using its :writer.
(when eieio-print-indentation
(princ (make-string (* eieio-print-depth 2) ? )))
(princ "(")
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 7a7b8ec1647..78cb8f08c34 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -5,6 +5,11 @@
;; Author: Noah Friedman <friedman@splode.com>
;; Keywords: extensions
;; Created: 1995-10-06
+;; Version: 1.11.0
+;; Package-Requires: ((emacs "26.3"))
+
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -32,20 +37,18 @@
;; the one-line documentation for that variable instead, to remind you of
;; that variable's meaning.
-;; One useful way to enable this minor mode is to put the following in your
-;; .emacs:
-;;
-;; (add-hook 'emacs-lisp-mode-hook 'eldoc-mode)
-;; (add-hook 'lisp-interaction-mode-hook 'eldoc-mode)
-;; (add-hook 'ielm-mode-hook 'eldoc-mode)
-;; (add-hook 'eval-expression-minibuffer-setup-hook 'eldoc-mode)
+;; This mode is now enabled by default in all major modes that provide
+;; support for it, such as `emacs-lisp-mode'.
+;; This is controlled by `global-eldoc-mode'.
-;; Major modes for other languages may use ElDoc by defining an
-;; appropriate function as the buffer-local value of
-;; `eldoc-documentation-function'.
+;; Major modes for other languages may use ElDoc by adding an
+;; appropriate function to the buffer-local value of
+;; `eldoc-documentation-functions'.
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defgroup eldoc nil
"Show function arglist or variable docstring in echo area."
:group 'lisp
@@ -57,20 +60,23 @@ If user input arrives before this interval of time has elapsed after the
last input, no documentation will be printed.
If this variable is set to 0, no idle time is required."
- :type 'number
- :group 'eldoc)
+ :type 'number)
(defcustom eldoc-print-after-edit nil
"If non-nil eldoc info is only shown when editing.
Changing the value requires toggling `eldoc-mode'."
+ :type 'boolean)
+
+(defcustom eldoc-echo-area-display-truncation-message t
+ "If non-nil, provide verbose help when a message has been truncated.
+If nil, truncated messages will just have \"...\" appended."
:type 'boolean
- :group 'eldoc)
+ :version "28.1")
;;;###autoload
(defcustom eldoc-minor-mode-string (purecopy " ElDoc")
"String to display in mode line when ElDoc Mode is enabled; nil for none."
- :type '(choice string (const :tag "None" nil))
- :group 'eldoc)
+ :type '(choice string (const :tag "None" nil)))
(defcustom eldoc-argument-case #'identity
"Case to display argument names of functions, as a symbol.
@@ -79,42 +85,55 @@ Actually, any name of a function which takes a string as an argument and
returns another string is acceptable.
Note that this variable has no effect, unless
-`eldoc-documentation-function' handles it explicitly."
+`eldoc-documentation-strategy' handles it explicitly."
:type '(radio (function-item upcase)
(function-item downcase)
- function)
- :group 'eldoc)
+ function))
(make-obsolete-variable 'eldoc-argument-case nil "25.1")
(defcustom eldoc-echo-area-use-multiline-p 'truncate-sym-name-if-fit
- "Allow long ElDoc messages to resize echo area display.
-If value is t, never attempt to truncate messages; complete symbol name
-and function arglist or 1-line variable documentation will be displayed
-even if echo area must be resized to fit.
-
-If value is any non-nil value other than t, symbol name may be truncated
-if it will enable the function arglist or documentation string to fit on a
-single line without resizing window. Otherwise, behavior is just like
-former case.
-
-If value is nil, messages are always truncated to fit in a single line of
-display in the echo area. Function or variable symbol name may be
-truncated to make more of the arglist or documentation string visible.
-
-Note that this variable has no effect, unless
-`eldoc-documentation-function' handles it explicitly."
- :type '(radio (const :tag "Always" t)
- (const :tag "Never" nil)
- (const :tag "Yes, but truncate symbol names if it will\
- enable argument list to fit on one line" truncate-sym-name-if-fit))
- :group 'eldoc)
+ "Allow long ElDoc doc strings to resize echo area display.
+If value is t, never attempt to truncate messages, even if the
+echo area must be resized to fit.
+
+If the value is a positive number, it is used to calculate a
+number of logical lines of documentation that ElDoc is allowed to
+put in the echo area. If a positive integer, the number is used
+directly, while a float specifies the number of lines as a
+proporting of the echo area frame's height.
+
+If value is the symbol `truncate-sym-name-if-fit' t, the part of
+the doc string that represents a symbol's name may be truncated
+if it will enable the rest of the doc string to fit on a single
+line, without resizing the echo area.
+
+If value is nil, a doc string is always truncated to fit in a
+single line of display in the echo area.
+
+Any resizing of the echo area additionally respects
+`max-mini-window-height'."
+ :type '(radio (const :tag "Always" t)
+ (float :tag "Fraction of frame height" 0.25)
+ (integer :tag "Number of lines" 5)
+ (const :tag "Never" nil)
+ (const :tag "Yes, but ask major-mode to truncate
+ symbol names if it will\ enable argument list to fit on one
+ line" truncate-sym-name-if-fit)))
+
+(defcustom eldoc-echo-area-prefer-doc-buffer nil
+ "Prefer ElDoc's documentation buffer if it is showing in some frame.
+If this variable's value is t, ElDoc will skip showing
+documentation in the echo area if the dedicated documentation
+buffer (given by `eldoc-doc-buffer') is being displayed in some
+window. If the value is the symbol `maybe', then the echo area
+is only skipped if the documentation doesn't fit there."
+ :type 'boolean)
(defface eldoc-highlight-function-argument
'((t (:inherit bold)))
"Face used for the argument at point in a function's argument list.
-Note that this face has no effect unless the `eldoc-documentation-function'
-handles it explicitly."
- :group 'eldoc)
+Note that this face has no effect unless the `eldoc-documentation-strategy'
+handles it explicitly.")
;;; No user options below here.
@@ -155,7 +174,7 @@ directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.")
This is used to determine if `eldoc-idle-delay' is changed by the user.")
(defvar eldoc-message-function #'eldoc-minibuffer-message
- "The function used by `eldoc-message' to display messages.
+ "The function used by `eldoc--message' to display messages.
It should receive the same arguments as `message'.")
(defun eldoc-edit-message-commands ()
@@ -182,8 +201,7 @@ area displays information about a function or variable in the
text where point is. If point is on a documented variable, it
displays the first line of that variable's doc string. Otherwise
it displays the argument list of the function called in the
-expression point is on."
- :group 'eldoc :lighter eldoc-minor-mode-string
+expression point is on." :lighter eldoc-minor-mode-string
(setq eldoc-last-message nil)
(cond
((not (eldoc--supported-p))
@@ -193,24 +211,23 @@ expression point is on."
(eldoc-mode
(when eldoc-print-after-edit
(setq-local eldoc-message-commands (eldoc-edit-message-commands)))
- (add-hook 'post-command-hook 'eldoc-schedule-timer nil t)
- (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area nil t))
+ (add-hook 'post-command-hook #'eldoc-schedule-timer nil t)
+ (add-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area nil t))
(t
(kill-local-variable 'eldoc-message-commands)
- (remove-hook 'post-command-hook 'eldoc-schedule-timer t)
- (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t)
+ (remove-hook 'post-command-hook #'eldoc-schedule-timer t)
+ (remove-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area t)
(when eldoc-timer
(cancel-timer eldoc-timer)
(setq eldoc-timer nil)))))
;;;###autoload
(define-globalized-minor-mode global-eldoc-mode eldoc-mode turn-on-eldoc-mode
- :group 'eldoc
:initialize 'custom-initialize-delay
:init-value t
;; For `read--expression', the usual global mode mechanism of
;; `change-major-mode-hook' runs in the minibuffer before
- ;; `eldoc-documentation-function' is set, so `turn-on-eldoc-mode'
+ ;; `eldoc-documentation-strategy' is set, so `turn-on-eldoc-mode'
;; does nothing. Configure and enable eldoc from
;; `eval-expression-minibuffer-setup-hook' instead.
(if global-eldoc-mode
@@ -222,21 +239,25 @@ expression point is on."
(defun eldoc--eval-expression-setup ()
;; Setup `eldoc', similar to `emacs-lisp-mode'. FIXME: Call
;; `emacs-lisp-mode' itself?
- (add-function :before-until (local 'eldoc-documentation-function)
- #'elisp-eldoc-documentation-function)
+ (cond ((<= emacs-major-version 27)
+ (declare-function elisp-eldoc-documentation-function "elisp-mode")
+ (with-no-warnings
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'elisp-eldoc-documentation-function)))
+ (t (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-var-docstring nil t)
+ (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-funcall nil t)
+ (setq eldoc-documentation-strategy 'eldoc-documentation-default)))
(eldoc-mode +1))
;;;###autoload
(defun turn-on-eldoc-mode ()
"Turn on `eldoc-mode' if the buffer has ElDoc support enabled.
-See `eldoc-documentation-function' for more detail."
+See `eldoc-documentation-strategy' for more detail."
(when (eldoc--supported-p)
(eldoc-mode 1)))
-(defun eldoc--supported-p ()
- "Non-nil if an ElDoc function is set for this buffer."
- (not (memq eldoc-documentation-function '(nil ignore))))
-
(defun eldoc-schedule-timer ()
"Ensure `eldoc-timer' is running.
@@ -252,7 +273,9 @@ reflect the change."
(when (or eldoc-mode
(and global-eldoc-mode
(eldoc--supported-p)))
- (eldoc-print-current-symbol-info))))))
+ ;; Don't ignore, but also don't full-on signal errors
+ (with-demoted-errors "eldoc error: %s"
+ (eldoc-print-current-symbol-info)) )))))
;; If user has changed the idle delay, update the timer.
(cond ((not (= eldoc-idle-delay eldoc-current-idle-delay))
@@ -277,28 +300,29 @@ Otherwise work like `message'."
(or (window-in-direction 'above (minibuffer-window))
(minibuffer-selected-window)
(get-largest-window)))
- (when mode-line-format
- (unless (and (listp mode-line-format)
- (assq 'eldoc-mode-line-string mode-line-format))
+ (when (and mode-line-format
+ (not (and (listp mode-line-format)
+ (assq 'eldoc-mode-line-string mode-line-format))))
(setq mode-line-format
(list "" '(eldoc-mode-line-string
(" " eldoc-mode-line-string " "))
- mode-line-format))))
+ mode-line-format)))
(setq eldoc-mode-line-string
(when (stringp format-string)
(apply #'format-message format-string args)))
(force-mode-line-update)))
- (apply 'message format-string args)))
+ (apply #'message format-string args)))
-(defun eldoc-message (&optional string)
+(make-obsolete
+ 'eldoc-message "use `eldoc-documentation-functions' instead." "eldoc-1.1.0")
+(defun eldoc-message (&optional string) (eldoc--message string))
+(defun eldoc--message (&optional string)
"Display STRING as an ElDoc message if it's non-nil.
Also store it in `eldoc-last-message' and return that value."
(let ((omessage eldoc-last-message))
(setq eldoc-last-message string)
- ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages
- ;; are recorded in a log. Do not put eldoc messages in that log since
- ;; they are Legion.
+ ;; Do not put eldoc messages in the log since they are Legion.
;; Emacs way of preventing log messages.
(let ((message-log-max nil))
(cond (eldoc-last-message
@@ -311,34 +335,45 @@ Also store it in `eldoc-last-message' and return that value."
(and (symbolp command)
(intern-soft (symbol-name command) eldoc-message-commands)))
-;; This function goes on pre-command-hook for XEmacs or when using idle
-;; timers in Emacs. Motion commands clear the echo area for some reason,
+;; This function goes on pre-command-hook.
+;; Motion commands clear the echo area for some reason,
;; which make eldoc messages flicker or disappear just before motion
;; begins. This function reprints the last eldoc message immediately
;; before the next command executes, which does away with the flicker.
;; This doesn't seem to be required for Emacs 19.28 and earlier.
+;; FIXME: The above comment suggests we don't really understand why
+;; this is needed. Maybe it's not needed any more, but if it is
+;; we should figure out why.
(defun eldoc-pre-command-refresh-echo-area ()
"Reprint `eldoc-last-message' in the echo area."
(and eldoc-last-message
(not (minibufferp)) ;We don't use the echo area when in minibuffer.
(if (and (eldoc-display-message-no-interference-p)
(eldoc--message-command-p this-command))
- (eldoc-message eldoc-last-message)
- ;; No need to call eldoc-message since the echo area will be cleared
+ (eldoc--message eldoc-last-message)
+ ;; No need to call eldoc--message since the echo area will be cleared
;; for us, but do note that the last-message will be gone.
(setq eldoc-last-message nil))))
-;; Decide whether now is a good time to display a message.
+;; The point of `eldoc--request-state' is not to over-request, which
+;; can happen if the idle timer is restarted on execution of command
+;; which is guaranteed not to change the conditions that warrant a new
+;; request for documentation.
+(defvar eldoc--last-request-state nil
+ "Tuple containing information about last ElDoc request.")
+(defun eldoc--request-state ()
+ "Compute information to store in `eldoc--last-request-state'."
+ (list (current-buffer) (buffer-modified-tick) (point)))
+
(defun eldoc-display-message-p ()
- "Return non-nil when it is appropriate to display an ElDoc message."
+ "Tell if ElDoc can use the echo area."
(and (eldoc-display-message-no-interference-p)
- ;; If this-command is non-nil while running via an idle
- ;; timer, we're still in the middle of executing a command,
- ;; e.g. a query-replace where it would be annoying to
- ;; overwrite the echo area.
(not this-command)
(eldoc--message-command-p last-command)))
+(make-obsolete 'eldoc-display-message-p
+ "Use `eldoc-documentation-functions' instead."
+ "eldoc-1.6.0")
;; Check various conditions about the current environment that might make
;; it undesirable to print eldoc messages right this instant.
@@ -347,75 +382,501 @@ Also store it in `eldoc-last-message' and return that value."
(not (or executing-kbd-macro (bound-and-true-p edebug-active))))
-;;;###autoload
-(defvar eldoc-documentation-function #'ignore
- "Function to call to return doc string.
-The function of no args should return a one-line string for displaying
-doc about a function etc. appropriate to the context around point.
-It should return nil if there's no doc appropriate for the context.
-Typically doc is returned if point is on a function-like name or in its
-arg list.
-
-The result is used as is, so the function must explicitly handle
-the variables `eldoc-argument-case' and `eldoc-echo-area-use-multiline-p',
-and the face `eldoc-highlight-function-argument', if they are to have any
-effect.
-
-Major modes should modify this variable using `add-function', for example:
- (add-function :before-until (local \\='eldoc-documentation-function)
- #\\='foo-mode-eldoc-function)
-so that the global documentation function (i.e. the default value of the
-variable) is taken into account if the major mode specific function does not
+(defvar eldoc-documentation-functions nil
+ "Hook of functions that produce doc strings.
+
+A doc string is typically relevant if point is on a function-like
+name, inside its arg list, or on any object with some associated
+information.
+
+Each hook function is called with at least one argument CALLBACK,
+a function, and decides whether to display a doc short string
+about the context around point.
+
+- If that decision can be taken quickly, the hook function may
+ call CALLBACK immediately following the protocol described
+ below. Alternatively it may ignore CALLBACK entirely and
+ return either the doc string, or nil if there's no doc
+ appropriate for the context.
+
+- If the computation of said doc string (or the decision whether
+ there is one at all) is expensive or can't be performed
+ directly, the hook function should return a non-nil, non-string
+ value and arrange for CALLBACK to be called at a later time,
+ using asynchronous processes or other asynchronous mechanisms.
+
+To call the CALLBACK function, the hook function must pass it an
+obligatory argument DOCSTRING, a string containing the
+documentation, followed by an optional list of arbitrary
+keyword-value pairs of the form (:KEY VALUE :KEY2 VALUE2...).
+The information contained in these pairs is understood by members
+of `eldoc-display-functions', allowing the
+documentation-producing backend to cooperate with specific
+documentation-displaying frontends. For example, KEY can be:
+
+* `:thing', VALUE being a short string or symbol designating what
+ is being reported on. It can, for example be the name of the
+ function whose signature is being documented, or the name of
+ the variable whose docstring is being documented.
+ `eldoc-display-in-echo-area', a member of
+ `eldoc-display-functions', sometimes omits this information
+ depending on space constraints;
+
+* `:face', VALUE being a symbol designating a face which both
+ `eldoc-display-in-echo-area' and `eldoc-display-in-buffer' will
+ use when displaying `:thing''s value.
+
+Finally, major modes should modify this hook locally, for
+example:
+ (add-hook \\='eldoc-documentation-functions #\\='foo-mode-eldoc nil t)
+so that the global value (i.e. the default value of the hook) is
+taken into account if the major mode specific function does not
return any documentation.")
-(defun eldoc-print-current-symbol-info ()
- "Print the text produced by `eldoc-documentation-function'."
- ;; This is run from post-command-hook or some idle timer thing,
- ;; so we need to be careful that errors aren't ignored.
- (with-demoted-errors "eldoc error: %s"
- (if (not (eldoc-display-message-p))
- ;; Erase the last message if we won't display a new one.
- (when eldoc-last-message
- (eldoc-message nil))
- (let ((non-essential t))
- ;; Only keep looking for the info as long as the user hasn't
- ;; requested our attention. This also locally disables inhibit-quit.
- (while-no-input
- (eldoc-message (funcall eldoc-documentation-function)))))))
-
-;; If the entire line cannot fit in the echo area, the symbol name may be
-;; truncated or eliminated entirely from the output to make room for the
-;; description.
-(defun eldoc-docstring-format-sym-doc (prefix doc &optional face)
- "Combine PREFIX and DOC, and shorten the result to fit in the echo area.
-
-When PREFIX is a symbol, propertize its symbol name with FACE
-before combining it with DOC. If FACE is not provided, just
-apply the nil face.
-
-See also: `eldoc-echo-area-use-multiline-p'."
- (when (symbolp prefix)
- (setq prefix (concat (propertize (symbol-name prefix) 'face face) ": ")))
- (let* ((ea-multi eldoc-echo-area-use-multiline-p)
- ;; Subtract 1 from window width since emacs will not write
- ;; any chars to the last column, or in later versions, will
- ;; cause a wraparound and resize of the echo area.
- (ea-width (1- (window-width (minibuffer-window))))
- (strip (- (+ (length prefix) (length doc)) ea-width)))
- (cond ((or (<= strip 0)
- (eq ea-multi t)
- (and ea-multi (> (length doc) ea-width)))
- (concat prefix doc))
- ((> (length doc) ea-width)
- (substring (format "%s" doc) 0 ea-width))
- ((>= strip (string-match-p ":? *\\'" prefix))
- doc)
+(defvar eldoc-display-functions
+ '(eldoc-display-in-echo-area eldoc-display-in-buffer)
+ "Hook of functions tasked with displaying ElDoc results.
+Each function is passed two arguments: DOCS and INTERACTIVE. DOCS
+is a list (DOC ...) where DOC looks like (STRING :KEY VALUE :KEY2
+VALUE2 ...). STRING is a string containing the documentation's
+text and the remainder of DOC is an optional list of
+keyword-value pairs denoting additional properties of that
+documentation. For commonly recognized properties, see
+`eldoc-documentation-functions'.
+
+INTERACTIVE says if the request to display doc strings came
+directly from the user or from ElDoc's automatic mechanisms'.")
+
+(defvar eldoc--doc-buffer nil "Buffer displaying latest ElDoc-produced docs.")
+
+(defvar eldoc--doc-buffer-docs nil "Documentation items in `eldoc--doc-buffer'.")
+
+(defun eldoc-doc-buffer ()
+ "Display ElDoc documentation buffer.
+
+This holds the results of the last documentation request."
+ (interactive)
+ (unless (buffer-live-p eldoc--doc-buffer)
+ (user-error (format
+ "ElDoc buffer doesn't exist, maybe `%s' to produce one."
+ (substitute-command-keys "\\[eldoc]"))))
+ (with-current-buffer eldoc--doc-buffer
+ (rename-buffer (replace-regexp-in-string "^ *" ""
+ (buffer-name)))
+ (display-buffer (current-buffer))))
+
+(defun eldoc--format-doc-buffer (docs)
+ "Ensure DOCS are displayed in an *eldoc* buffer."
+ (interactive (list t))
+ (with-current-buffer (if (buffer-live-p eldoc--doc-buffer)
+ eldoc--doc-buffer
+ (setq eldoc--doc-buffer
+ (get-buffer-create " *eldoc*")))
+ (unless (eq docs eldoc--doc-buffer-docs)
+ (setq-local eldoc--doc-buffer-docs docs)
+ (let ((inhibit-read-only t)
+ (things-reported-on))
+ (erase-buffer) (setq buffer-read-only t)
+ (local-set-key "q" 'quit-window)
+ (cl-loop for (docs . rest) on docs
+ for (this-doc . plist) = docs
+ for thing = (plist-get plist :thing)
+ when thing do
+ (cl-pushnew thing things-reported-on)
+ (setq this-doc
+ (concat
+ (propertize (format "%s" thing)
+ 'face (plist-get plist :face))
+ ": "
+ this-doc))
+ do (insert this-doc)
+ when rest do (insert "\n")
+ finally (goto-char (point-min)))
+ ;; Rename the buffer, taking into account whether it was
+ ;; hidden or not
+ (rename-buffer (format "%s*eldoc%s*"
+ (if (string-match "^ " (buffer-name)) " " "")
+ (if things-reported-on
+ (format " for %s"
+ (mapconcat
+ (lambda (s) (format "%s" s))
+ things-reported-on
+ ", "))
+ ""))))))
+ eldoc--doc-buffer)
+
+(defun eldoc--echo-area-substring (available)
+ "Given AVAILABLE lines, get buffer substring to display in echo area.
+Helper for `eldoc-display-in-echo-area'."
+ (let ((start (prog1 (progn
+ (goto-char (point-min))
+ (skip-chars-forward " \t\n")
+ (point))
+ (goto-char (line-end-position available))
+ (skip-chars-backward " \t\n")))
+ (truncated (save-excursion
+ (skip-chars-forward " \t\n")
+ (not (eobp)))))
+ (cond ((eldoc--echo-area-prefer-doc-buffer-p truncated)
+ nil)
+ ((and truncated
+ (> available 1)
+ eldoc-echo-area-display-truncation-message)
+ (goto-char (line-end-position 0))
+ (concat (buffer-substring start (point))
+ (format
+ "\n(Documentation truncated. Use `%s' to see rest)"
+ (substitute-command-keys "\\[eldoc-doc-buffer]"))))
(t
- ;; Show the end of the partial symbol name, rather
- ;; than the beginning, since the former is more likely
- ;; to be unique given package namespace conventions.
- (concat (substring prefix strip) doc)))))
+ (buffer-substring start (point))))))
+
+(defun eldoc--echo-area-prefer-doc-buffer-p (truncatedp)
+ "Tell if display in the echo area should be skipped.
+Helper for `eldoc-display-in-echo-area'. If TRUNCATEDP the
+documentation to potentially appear in the echo are is truncated."
+ (and (or (eq eldoc-echo-area-prefer-doc-buffer t)
+ (and truncatedp
+ (eq eldoc-echo-area-prefer-doc-buffer
+ 'maybe)))
+ (get-buffer-window eldoc--doc-buffer)))
+
+(defun eldoc-display-in-echo-area (docs _interactive)
+ "Display DOCS in echo area.
+Honor `eldoc-echo-area-use-multiline-p' and
+`eldoc-echo-area-prefer-doc-buffer'."
+ (cond
+ (;; Check if he wave permission to mess with echo area at all. For
+ ;; example, if this-command is non-nil while running via an idle
+ ;; timer, we're still in the middle of executing a command, e.g. a
+ ;; query-replace where it would be annoying to overwrite the echo
+ ;; area.
+ (or
+ (not (eldoc-display-message-no-interference-p))
+ this-command
+ (not (eldoc--message-command-p last-command))))
+ (;; If we do but nothing to report, clear the echo area.
+ (null docs)
+ (eldoc--message nil))
+ (t
+ ;; Otherwise, establish some parameters.
+ (let*
+ ((width (1- (window-width (minibuffer-window))))
+ (val (if (and (symbolp eldoc-echo-area-use-multiline-p)
+ eldoc-echo-area-use-multiline-p)
+ max-mini-window-height
+ eldoc-echo-area-use-multiline-p))
+ (available (cl-typecase val
+ (float (truncate (* (frame-height) val)))
+ (integer val)
+ (t 'just-one-line)))
+ single-doc single-doc-sym)
+ (let ((echo-area-message
+ (cond
+ (;; To output to the echo area, we handle the
+ ;; `truncate-sym-name-if-fit' special case first, by
+ ;; checking for a lot of special conditions.
+ (and
+ (eq 'truncate-sym-name-if-fit eldoc-echo-area-use-multiline-p)
+ (null (cdr docs))
+ (setq single-doc (caar docs))
+ (setq single-doc-sym
+ (format "%s" (plist-get (cdar docs) :thing)))
+ (< (length single-doc) width)
+ (not (string-match "\n" single-doc))
+ (> (+ (length single-doc) (length single-doc-sym) 2) width))
+ single-doc)
+ ((and (numberp available)
+ (cl-plusp available))
+ ;; Else, given a positive number of logical lines, we
+ ;; format the *eldoc* buffer, using as most of its
+ ;; contents as we know will fit.
+ (with-current-buffer (eldoc--format-doc-buffer docs)
+ (eldoc--echo-area-substring available)))
+ (t ;; this is the "truncate brutally" situation
+ (let ((string
+ (with-current-buffer (eldoc--format-doc-buffer docs)
+ (buffer-substring (goto-char (point-min))
+ (line-end-position 1)))))
+ (if (> (length string) width) ; truncation to happen
+ (unless (eldoc--echo-area-prefer-doc-buffer-p t)
+ (truncate-string-to-width string width))
+ (unless (eldoc--echo-area-prefer-doc-buffer-p nil)
+ string)))))))
+ (when echo-area-message
+ (eldoc--message echo-area-message)))))))
+
+(defun eldoc-display-in-buffer (docs interactive)
+ "Display DOCS in a dedicated buffer.
+If INTERACTIVE is t, also display the buffer."
+ (eldoc--format-doc-buffer docs)
+ (when interactive
+ (eldoc-doc-buffer)))
+
+(defun eldoc-documentation-default ()
+ "Show first doc string for item at point.
+Default value for `eldoc-documentation-strategy'."
+ (run-hook-with-args-until-success 'eldoc-documentation-functions
+ (eldoc--make-callback :patient)))
+
+(defun eldoc--documentation-compose-1 (eagerlyp)
+ "Helper function for composing multiple doc strings.
+If EAGERLYP is non-nil show documentation as soon as possible,
+else wait for all doc strings."
+ (run-hook-wrapped 'eldoc-documentation-functions
+ (lambda (f)
+ (let* ((callback (eldoc--make-callback
+ (if eagerlyp :eager :patient)))
+ (str (funcall f callback)))
+ (if (or (null str) (stringp str)) (funcall callback str))
+ nil)))
+ t)
+
+(defun eldoc-documentation-compose ()
+ "Show multiple doc strings at once after waiting for all.
+Meant as a value for `eldoc-documentation-strategy'."
+ (eldoc--documentation-compose-1 nil))
+
+(defun eldoc-documentation-compose-eagerly ()
+ "Show multiple doc strings at once as soon as possible.
+Meant as a value for `eldoc-documentation-strategy'."
+ (eldoc--documentation-compose-1 t))
+
+(defun eldoc-documentation-enthusiast ()
+ "Show most important doc string produced so far.
+Meant as a value for `eldoc-documentation-strategy'."
+ (run-hook-wrapped 'eldoc-documentation-functions
+ (lambda (f)
+ (let* ((callback (eldoc--make-callback :enthusiast))
+ (str (funcall f callback)))
+ (if (stringp str) (funcall callback str))
+ nil)))
+ t)
+
+;; JT@2020-07-10: ElDoc is pre-loaded, so in Emacs < 28 we can't
+;; make the "old" `eldoc-documentation-function' point to the new
+;; `eldoc-documentation-strategy', so we do the reverse. This allows
+;; for ElDoc to be loaded in those older Emacs versions and work with
+;; whomever (major-modes, extensions, user) sets one or the other
+;; variable.
+(defmacro eldoc--documentation-strategy-defcustom
+ (main secondary value docstring &rest more)
+ "Defcustom helper macro for sorting `eldoc-documentation-strategy'."
+ (declare (indent 2))
+ `(if (< emacs-major-version 28)
+ (progn
+ (defcustom ,secondary ,value ,docstring ,@more)
+ (define-obsolete-variable-alias ',main ',secondary "eldoc-1.1.0"))
+ (progn
+ (defcustom ,main ,value ,docstring ,@more)
+ (defvaralias ',secondary ',main ,docstring))))
+
+(eldoc--documentation-strategy-defcustom eldoc-documentation-strategy
+ eldoc-documentation-function
+ #'eldoc-documentation-default
+ "How to collect and organize results of `eldoc-documentation-functions'.
+
+This variable controls how `eldoc-documentation-functions', which
+specifies the sources of documentation, is queried and how its
+results are organized before being displayed to the user. The
+following values are allowed:
+
+- `eldoc-documentation-default': calls functions in the special
+ hook in order until one is found that produces a doc string
+ value. Display only that value;
+
+- `eldoc-documentation-compose': calls all functions in the
+ special hook and displays all of the resulting doc strings
+ together. Wait for all strings to be ready, and preserve their
+ relative as specified by the order of functions in the hook;
+
+- `eldoc-documentation-compose-eagerly': calls all functions in
+ the special hook and display as many of the resulting doc
+ strings as possible, as soon as possibl. Preserving the
+ relative order of doc strings;
+
+- `eldoc-documentation-enthusiast': calls all functions in the
+ special hook and displays only the most important resulting
+ docstring one at any given time. A function appearing first in
+ the special hook is considered more important.
+
+This variable can also be set to a function of no args that
+returns something other than a string or nil and allows for some
+or all of the special hook `eldoc-documentation-functions' to be
+run. In that case, the strategy function should follow that
+other variable's protocol closely and endeavor to display the
+resulting doc strings itself.
+
+For backward compatibility to the \"old\" protocol, this variable
+can also be set to a function that returns nil or a doc string,
+depending whether or not there is documentation to display at
+all."
+ :link '(info-link "(emacs) Lisp Doc")
+ :type '(radio (function-item eldoc-documentation-default)
+ (function-item eldoc-documentation-compose)
+ (function-item eldoc-documentation-compose-eagerly)
+ (function-item eldoc-documentation-enthusiast)
+ (function :tag "Other function"))
+ :version "28.1")
+
+(defun eldoc--supported-p ()
+ "Non-nil if an ElDoc function is set for this buffer."
+ (and (not (memq eldoc-documentation-strategy '(nil ignore)))
+ (or eldoc-documentation-functions
+ ;; The old API had major modes set `eldoc-documentation-function'
+ ;; to provide eldoc support. It's impossible now to determine
+ ;; reliably whether the `eldoc-documentation-strategy' provides
+ ;; eldoc support (as in the old API) or whether it just provides
+ ;; a way to combine the results of the
+ ;; `eldoc-documentation-functions' (as in the new API).
+ ;; But at least if it's set buffer-locally it's a good hint that
+ ;; there's some eldoc support in the current buffer.
+ (local-variable-p 'eldoc-documentation-strategy))))
+
+(defvar eldoc--enthusiasm-curbing-timer nil
+ "Timer used by the `eldoc-documentation-enthusiast' strategy.
+When a doc string is encountered, it must endure a certain amount
+of time unchallenged until it is displayed to the user. This
+prevents blinking if a lower priority docstring comes in shortly
+before a higher priority one.")
+
+(defalias 'eldoc #'eldoc-print-current-symbol-info)
+
+;; This variable should be unbound, but that confuses
+;; `describe-symbol' for some reason.
+(defvar eldoc--make-callback nil "Helper for function `eldoc--make-callback'.")
+
+;; JT@2020-07-08: the below docstring for the internal function
+;; `eldoc--invoke-strategy' could be moved to
+;; `eldoc-documentation-strategy' or thereabouts if/when we decide to
+;; extend or publish the `make-callback' protocol.
+(defun eldoc--make-callback (method)
+ "Make callback suitable for `eldoc-documentation-functions'.
+The return value is a function FN whose lambda list is (STRING
+&rest PLIST) and can be called by those functions. Its
+responsibility is always to register the docstring STRING along
+with options specified in PLIST as the documentation to display
+for each particular situation.
+
+METHOD specifies how the callback behaves relative to other
+competing elements in `eldoc-documentation-functions'. It can
+have the following values:
+
+- `:enthusiast' says to display STRING as soon as possible if
+ there's no higher priority doc string;
+
+- `:patient' says to display STRING along with all other
+ competing strings but only when all of all
+ `eldoc-documentation-functions' have been collected;
+
+- `:eager' says to display STRING along with all other competing
+ strings so far, as soon as possible."
+ (funcall eldoc--make-callback method))
+
+(defun eldoc--invoke-strategy (interactive)
+ "Invoke `eldoc-documentation-strategy' function.
+
+If INTERACTIVE is non-nil, the request came directly from a user
+command, otherwise it came from ElDoc's idle
+timer, `eldoc-timer'.
+
+That function's job is to run the `eldoc-documentation-functions'
+special hook, using the `run-hook' family of functions. ElDoc's
+built-in strategy functions play along with the
+`eldoc--make-callback' protocol, using it to produce a callback
+argument to feed the functions that the user places in
+`eldoc-documentation-functions'. Whenever the strategy
+determines it has information to display to the user, this
+function passes responsibility to the functions in
+`eldoc-display-functions'.
+
+Other third-party values of `eldoc-documentation-strategy' should
+not use `eldoc--make-callback'. They must find some alternate
+way to produce callbacks to feed to
+`eldoc-documentation-function' and should endeavour to display
+the docstrings eventually produced, using
+`eldoc-display-functions'."
+ (let* (;; How many callbacks have been created by the strategy
+ ;; function and passed to elements of
+ ;; `eldoc-documentation-functions'.
+ (howmany 0)
+ ;; How many calls to callbacks we're still waiting on. Used
+ ;; by `:patient'.
+ (want 0)
+ ;; The doc strings and corresponding options registered so
+ ;; far.
+ (docs-registered '()))
+ (cl-labels
+ ((register-doc
+ (pos string plist)
+ (when (and string (> (length string) 0))
+ (push (cons pos (cons string plist)) docs-registered)))
+ (display-doc
+ ()
+ (run-hook-with-args
+ 'eldoc-display-functions (mapcar #'cdr
+ (setq docs-registered
+ (sort docs-registered
+ (lambda (a b) (< (car a) (car b))))))
+ interactive))
+ (make-callback
+ (method)
+ (let ((pos (prog1 howmany (cl-incf howmany))))
+ (cl-ecase method
+ (:enthusiast
+ (lambda (string &rest plist)
+ (when (and string (cl-loop for (p) in docs-registered
+ never (< p pos)))
+ (setq docs-registered '())
+ (register-doc pos string plist))
+ (when (and (timerp eldoc--enthusiasm-curbing-timer)
+ (memq eldoc--enthusiasm-curbing-timer
+ timer-list))
+ (cancel-timer eldoc--enthusiasm-curbing-timer))
+ (setq eldoc--enthusiasm-curbing-timer
+ (run-at-time (unless (zerop pos) 0.3)
+ nil #'display-doc))
+ t))
+ (:patient
+ (cl-incf want)
+ (lambda (string &rest plist)
+ (register-doc pos string plist)
+ (when (zerop (cl-decf want)) (display-doc))
+ t))
+ (:eager
+ (lambda (string &rest plist)
+ (register-doc pos string plist)
+ (display-doc)
+ t))))))
+ (let* ((eldoc--make-callback #'make-callback)
+ (res (funcall eldoc-documentation-strategy)))
+ ;; Observe the old and the new protocol:
+ (cond (;; Old protocol: got string, output immediately;
+ (stringp res) (register-doc 0 res nil) (display-doc))
+ (;; Old protocol: got nil, clear the echo area;
+ (null res) (eldoc--message nil))
+ (;; New protocol: trust callback will be called;
+ t))))))
+
+(defun eldoc-print-current-symbol-info (&optional interactive)
+ "Document thing at point."
+ (interactive '(t))
+ (let (token)
+ (cond (interactive
+ (eldoc--invoke-strategy t))
+ ((not (equal (setq token (eldoc--request-state))
+ eldoc--last-request-state))
+ (let ((non-essential t))
+ (setq eldoc--last-request-state token)
+ ;; Only keep looking for the info as long as the user hasn't
+ ;; requested our attention. This also locally disables
+ ;; inhibit-quit.
+ (while-no-input
+ (eldoc--invoke-strategy nil)))))))
+
+;; This section only affects ElDoc output to the echo area, as in
+;; `eldoc-display-in-echo-area'.
+;;
;; When point is in a sexp, the function args are not reprinted in the echo
;; area after every possible interactive command because some of them print
;; their own messages in the echo area; the eldoc functions would instantly
@@ -447,7 +908,6 @@ See also: `eldoc-echo-area-use-multiline-p'."
(apply #'eldoc-remove-command
(all-completions name eldoc-message-commands))))
-
;; Prime the command list.
(eldoc-add-command-completions
"back-to-indentation"
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index f68c0faf09d..a94978ac47b 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -342,9 +342,9 @@ Use optional LIST if provided instead."
(interactive
(list
(intern
- (completing-read "Master function: " obarray
- #'elp--instrumented-p
- t nil nil (if elp-master (symbol-name elp-master))))))
+ (let ((default (if elp-master (symbol-name elp-master))))
+ (completing-read (format-prompt "Master function" default)
+ obarray #'elp--instrumented-p t nil nil default)))))
;; When there's a master function, recording is turned off by default.
(setq elp-master funsym
elp-record-p nil)
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 622f5654b25..a8da2c413e0 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -30,6 +30,7 @@
(eval-when-compile (require 'cl-lib))
(require 'ert)
+(require 'subr-x) ; string-trim
;;; Test buffers.
@@ -177,6 +178,18 @@ test for `called-interactively' in the command will fail."
(cl-assert (not unread-command-events) t)
return-value))
+(defmacro ert-simulate-keys (keys &rest body)
+ "Execute BODY with KEYS as pseudo-interactive input."
+ (declare (debug t) (indent 1))
+ `(let ((unread-command-events
+ ;; Add some C-g to try and make sure we still exit
+ ;; in case something goes wrong.
+ (append ,keys '(?\C-g ?\C-g ?\C-g)))
+ ;; Tell `read-from-minibuffer' not to read from stdin when in
+ ;; batch mode.
+ (executing-kbd-macro t))
+ ,@body))
+
(defun ert-run-idle-timers ()
"Run all idle timers (from `timer-idle-list')."
(dolist (timer (copy-sequence timer-idle-list))
@@ -341,6 +354,46 @@ convert it to a string and pass it to COLLECTOR first."
(funcall func object)))
(funcall func object printcharfun))))
+(defvar ert-resource-directory-format "%s-resources/"
+ "Format for `ert-resource-directory'.")
+(defvar ert-resource-directory-trim-left-regexp ""
+ "Regexp for `string-trim' (left) used by `ert-resource-directory'.")
+(defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el"
+ "Regexp for `string-trim' (right) used by `ert-resource-directory'.")
+
+;; Has to be a macro for `load-file-name'.
+(defmacro ert-resource-directory ()
+ "Return absolute file name of the resource (test data) directory.
+
+The path to the resource directory is the \"resources\" directory
+in the same directory as the test file this is called from.
+
+If that directory doesn't exist, find a directory based on the
+test file name. If the file is named \"foo-tests.el\", return
+the absolute file name for \"foo-resources\". If you want a
+different resource directory naming scheme, set the variable
+`ert-resource-directory-format'. Before formatting, the file
+name will be trimmed using `string-trim' with arguments
+`ert-resource-directory-trim-left-regexp' and
+`ert-resource-directory-trim-right-regexp'."
+ `(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file)
+ (and load-in-progress load-file-name)
+ buffer-file-name))
+ (default-directory (file-name-directory testfile)))
+ (file-truename
+ (if (file-accessible-directory-p "resources/")
+ (expand-file-name "resources/")
+ (expand-file-name
+ (format ert-resource-directory-format
+ (string-trim testfile
+ ert-resource-directory-trim-left-regexp
+ ert-resource-directory-trim-right-regexp)))))))
+
+(defmacro ert-resource-file (file)
+ "Return file name of resource file named FILE.
+A resource file is in the resource directory as per
+`ert-resource-directory'."
+ `(expand-file-name ,file (ert-resource-directory)))
(provide 'ert-x)
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 3c4891b49ae..baa04f2c6af 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -515,7 +515,14 @@ Returns nil if they are."
`(cdr ,cdr-x)
(cl-assert (equal a b) t)
nil))))))))
- ((pred arrayp)
+ ((pred cl-struct-p)
+ (cl-loop for slot in (cl-struct-slot-info (type-of a))
+ for ai across a
+ for bi across b
+ for xf = (ert--explain-equal-rec ai bi)
+ do (when xf (cl-return `(struct-field ,(car slot) ,xf)))
+ finally (cl-assert (equal a b) t)))
+ ((or (pred arrayp) (pred recordp))
;; For mixed unibyte/multibyte string comparisons, make both multibyte.
(when (and (stringp a)
(xor (multibyte-string-p a) (multibyte-string-p b)))
@@ -1298,7 +1305,8 @@ EXPECTEDP specifies whether the result was expected."
"Pretty-print OBJECT, indenting it to the current column of point.
Ensures a final newline is inserted."
(let ((begin (point))
- (pp-escape-newlines nil))
+ (pp-escape-newlines nil)
+ (print-escape-control-characters t))
(pp object (current-buffer))
(unless (bolp) (insert "\n"))
(save-excursion
@@ -1628,9 +1636,7 @@ Signals an error if no test name was read."
nil)))
(ert-test (setq default (ert-test-name default))))
(when add-default-to-prompt
- (setq prompt (if (null default)
- (format "%s: " prompt)
- (format "%s (default %s): " prompt default))))
+ (setq prompt (format-prompt prompt default)))
(let ((input (completing-read prompt obarray #'ert-test-boundp
t nil history default nil)))
;; completing-read returns an empty string if default was nil and
@@ -2016,9 +2022,7 @@ and how to display message."
(car ert--selector-history)
"t")))
(read
- (completing-read (if (null default)
- "Run tests: "
- (format "Run tests (default %s): " default))
+ (completing-read (format-prompt "Run tests" default)
obarray #'ert-test-boundp nil nil
'ert--selector-history default nil)))
nil))
diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el
index 78ada3e076d..5112322cfd6 100644
--- a/lisp/emacs-lisp/ewoc.el
+++ b/lisp/emacs-lisp/ewoc.el
@@ -205,15 +205,26 @@ NODE and leaving the new node's start there. Return the new node."
(defun ewoc--refresh-node (pp node dll)
"Redisplay the element represented by NODE using the pretty-printer PP."
- (let ((inhibit-read-only t)
- (m (ewoc--node-start-marker node))
- (R (ewoc--node-right node)))
- ;; First, remove the string from the buffer:
- (delete-region m (ewoc--node-start-marker R))
- ;; Calculate and insert the string.
- (goto-char m)
- (funcall pp (ewoc--node-data node))
- (ewoc--adjust m (point) R dll)))
+ (let* ((m (ewoc--node-start-marker node))
+ (R (ewoc--node-right node))
+ (end (ewoc--node-start-marker R))
+ (inhibit-read-only t)
+ (offset (if (= (point) end)
+ 'end
+ (when (< m (point) end)
+ (- (point) m)))))
+ (save-excursion
+ ;; First, remove the string from the buffer:
+ (delete-region m end)
+ ;; Calculate and insert the string.
+ (goto-char m)
+ (funcall pp (ewoc--node-data node))
+ (setq end (point))
+ (ewoc--adjust m (point) R dll))
+ (when offset
+ (goto-char (if (eq offset 'end)
+ end
+ (min (+ m offset) (1- end)))))))
(defun ewoc--wrap (func)
(lambda (data)
@@ -342,11 +353,10 @@ arguments will be passed to MAP-FUNCTION."
((footer (ewoc--footer ewoc))
(pp (ewoc--pretty-printer ewoc))
(node (ewoc--node-nth dll 1)))
- (save-excursion
- (while (not (eq node footer))
- (if (apply map-function (ewoc--node-data node) args)
- (ewoc--refresh-node pp node dll))
- (setq node (ewoc--node-next dll node))))))
+ (while (not (eq node footer))
+ (if (apply map-function (ewoc--node-data node) args)
+ (ewoc--refresh-node pp node dll))
+ (setq node (ewoc--node-next dll node)))))
(defun ewoc-delete (ewoc &rest nodes)
"Delete NODES from EWOC."
@@ -461,9 +471,8 @@ If the EWOC is empty, nil is returned."
Delete current text first, thus effecting a \"refresh\"."
(ewoc--set-buffer-bind-dll-let* ewoc
((pp (ewoc--pretty-printer ewoc)))
- (save-excursion
- (dolist (node nodes)
- (ewoc--refresh-node pp node dll)))))
+ (dolist (node nodes)
+ (ewoc--refresh-node pp node dll))))
(defun ewoc-goto-prev (ewoc arg)
"Move point to the ARGth previous element in EWOC.
@@ -566,9 +575,8 @@ Return nil if the buffer has been deleted."
(hf-pp (ewoc--hf-pp ewoc)))
(setf (ewoc--node-data head) header
(ewoc--node-data foot) footer)
- (save-excursion
- (ewoc--refresh-node hf-pp head dll)
- (ewoc--refresh-node hf-pp foot dll))))
+ (ewoc--refresh-node hf-pp head dll)
+ (ewoc--refresh-node hf-pp foot dll)))
(provide 'ewoc)
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 167ead3ce02..ee94e1fbff7 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -61,7 +61,7 @@
"^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\
ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
-menu-bar-make-toggle\\)"
+menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)"
find-function-space-re
"\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)")
"The regexp used by `find-function' to search for a function definition.
@@ -279,25 +279,17 @@ Interactively, prompt for LIBRARY using the one at or near point."
(switch-to-buffer (find-file-noselect (find-library-name library)))
(run-hooks 'find-function-after-hook)))
+;;;###autoload
(defun read-library-name ()
"Read and return a library name, defaulting to the one near point.
A library name is the filename of an Emacs Lisp library located
in a directory under `load-path' (or `find-function-source-path',
if non-nil)."
- (let* ((suffix-regexp (mapconcat
- (lambda (suffix)
- (concat (regexp-quote suffix) "\\'"))
- (find-library-suffixes)
- "\\|"))
- (table (cl-loop for dir in (or find-function-source-path load-path)
- when (file-readable-p dir)
- append (mapcar
- (lambda (file)
- (replace-regexp-in-string suffix-regexp
- "" file))
- (directory-files dir nil
- suffix-regexp))))
+ (let* ((dirs (or find-function-source-path load-path))
+ (suffixes (find-library-suffixes))
+ (table (apply-partially 'locate-file-completion-table
+ dirs suffixes))
(def (if (eq (function-called-at-point) 'require)
;; `function-called-at-point' may return 'require
;; with `point' anywhere on this line. So wrap the
@@ -313,9 +305,7 @@ if non-nil)."
(thing-at-point 'symbol))))
(when (and def (not (test-completion def table)))
(setq def nil))
- (completing-read (if def
- (format "Library name (default %s): " def)
- "Library name: ")
+ (completing-read (format-prompt "Library name" def)
table nil nil nil nil def)))
;;;###autoload
@@ -483,12 +473,10 @@ otherwise uses `variable-at-point'."
(prompt-type (cdr (assq type '((nil . "function")
(defvar . "variable")
(defface . "face")))))
- (prompt (concat "Find " prompt-type
- (and symb (format " (default %s)" symb))
- ": "))
(enable-recursive-minibuffers t))
(list (intern (completing-read
- prompt obarray predicate
+ (format-prompt "Find %s" symb prompt-type)
+ obarray predicate
t nil nil (and symb (symbol-name symb)))))))
(defun find-function-do-it (symbol type switch-fn)
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index 50b157b16a4..d92ca5b9337 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -1,4 +1,4 @@
-;;; float-sup.el --- define some constants useful for floating point numbers.
+;;; float-sup.el --- define some constants useful for floating point numbers. -*- lexical-binding:t -*-
;; Copyright (C) 1985-1987, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index 26ab2679e22..c95c758a571 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -153,7 +153,7 @@ DYNAMIC-VAR bound to STATIC-VAR."
(defun cps--add-state (kind body)
"Create a new CPS state of KIND with BODY and return the state's name."
(declare (indent 1))
- (let* ((state (cps--gensym "cps-state-%s-" kind)))
+ (let ((state (cps--gensym "cps-state-%s-" kind)))
(push (list state body cps--cleanup-function) cps--states)
(push state cps--bindings)
state))
@@ -673,7 +673,7 @@ When called as a function, NAME returns an iterator value that
encapsulates the state of a computation that produces a sequence
of values. Callers can retrieve each value using `iter-next'."
(declare (indent defun)
- (debug (&define name lambda-list lambda-doc def-body))
+ (debug (&define name lambda-list lambda-doc &rest sexp))
(doc-string 3))
(cl-assert lexical-binding)
(let* ((parsed-body (macroexp-parse-body body))
@@ -687,14 +687,14 @@ of values. Callers can retrieve each value using `iter-next'."
"Return a lambda generator.
`iter-lambda' is to `iter-defun' as `lambda' is to `defun'."
(declare (indent defun)
- (debug (&define lambda-list lambda-doc def-body)))
+ (debug (&define lambda-list lambda-doc &rest sexp)))
(cl-assert lexical-binding)
`(lambda ,arglist
,(cps-generate-evaluator body)))
(defmacro iter-make (&rest body)
"Return a new iterator."
- (declare (debug t))
+ (declare (debug (&rest sexp)))
(cps-generate-evaluator body))
(defconst iter-empty (lambda (_op _val) (signal 'iter-end-of-sequence nil))
@@ -720,7 +720,7 @@ is blocked."
Evaluate BODY with VAR bound to each value from ITERATOR.
Return the value with which ITERATOR finished iteration."
(declare (indent 1)
- (debug ((symbolp form) body)))
+ (debug ((symbolp form) &rest sexp)))
(let ((done-symbol (cps--gensym "iter-do-iterator-done"))
(condition-symbol (cps--gensym "iter-do-condition"))
(it-symbol (cps--gensym "iter-do-iterator"))
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 06ef5800568..3bc6d021dc8 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -116,6 +116,10 @@ instead (which see).")
function-list &optional docstring)
"Create a new generic mode MODE.
+A \"generic\" mode is a simple major mode with basic support for
+comment syntax and Font Lock mode, but otherwise does not have
+any special keystrokes or functionality available.
+
MODE is the name of the command for the generic mode; don't quote it.
The optional DOCSTRING is the documentation for the mode command. If
you do not supply it, `define-generic-mode' uses a default
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 065a9688770..5470b8532fc 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -166,15 +166,25 @@ arguments as NAME. DO is a function as defined in `gv-get'."
;; (`(expand ,expander) `(gv-define-expand ,name ,expander))
(_ (message "Unknown %s declaration %S" symbol handler) nil))))
+;; Additions for `declare'. We specify the values as named aliases so
+;; that `describe-variable' prints something useful; cf. Bug#40491.
+
+;;;###autoload
+(defsubst gv--expander-defun-declaration (&rest args)
+ (apply #'gv--defun-declaration 'gv-expander args))
+
+;;;###autoload
+(defsubst gv--setter-defun-declaration (&rest args)
+ (apply #'gv--defun-declaration 'gv-setter args))
+
;;;###autoload
(or (assq 'gv-expander defun-declarations-alist)
- (let ((x `(gv-expander
- ,(apply-partially #'gv--defun-declaration 'gv-expander))))
+ (let ((x (list 'gv-expander #'gv--expander-defun-declaration)))
(push x macro-declarations-alist)
(push x defun-declarations-alist)))
;;;###autoload
(or (assq 'gv-setter defun-declarations-alist)
- (push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
+ (push (list 'gv-setter #'gv--setter-defun-declaration)
defun-declarations-alist))
;; (defmacro gv-define-expand (name expander)
@@ -214,7 +224,7 @@ The first arg in ARGLIST (the one that receives VAL) receives an expression
which can do arbitrary things, whereas the other arguments are all guaranteed
to be pure and copyable. Example use:
(gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))"
- (declare (indent 2) (debug (&define name sexp def-body)))
+ (declare (indent 2) (debug (&define name :name gv-setter sexp def-body)))
`(gv-define-expander ,name
(lambda (do &rest args)
(declare-function
@@ -407,6 +417,17 @@ The return value is the last VAL in the list.
`(delq ,p ,getter))))))
,v))))))))))
+(gv-define-expander plist-get
+ (lambda (do plist prop)
+ (macroexp-let2 macroexp-copyable-p key prop
+ (gv-letplace (getter setter) plist
+ (macroexp-let2 nil p `(cdr (plist-member ,getter ,key))
+ (funcall do
+ `(car ,p)
+ (lambda (val)
+ `(if ,p
+ (setcar ,p ,val)
+ ,(funcall setter `(cons ,key (cons ,val ,getter)))))))))))
;;; Some occasionally handy extensions.
@@ -517,9 +538,12 @@ This macro only makes sense when used in a place."
(gv-letplace (dgetter dsetter) d
(funcall do
`(cons ,agetter ,dgetter)
- (lambda (v) `(progn
- ,(funcall asetter `(car ,v))
- ,(funcall dsetter `(cdr ,v)))))))))
+ (lambda (v)
+ (macroexp-let2 nil v v
+ `(progn
+ ,(funcall asetter `(car ,v))
+ ,(funcall dsetter `(cdr ,v))
+ ,v))))))))
(put 'logand 'gv-expander
(lambda (do place &rest masks)
@@ -529,9 +553,12 @@ This macro only makes sense when used in a place."
(funcall
do `(logand ,getter ,mask)
(lambda (v)
- (funcall setter
- `(logior (logand ,v ,mask)
- (logand ,getter (lognot ,mask))))))))))
+ (macroexp-let2 nil v v
+ `(progn
+ ,(funcall setter
+ `(logior (logand ,v ,mask)
+ (logand ,getter (lognot ,mask))))
+ ,v))))))))
;;; References
diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el
new file mode 100644
index 00000000000..8cef029c4cf
--- /dev/null
+++ b/lisp/emacs-lisp/hierarchy.el
@@ -0,0 +1,579 @@
+;;; hierarchy.el --- Library to create and display hierarchy structures -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Damien Cassou <damien@cassou.me>
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Library to create, query, navigate and display hierarchy structures.
+
+;; Creation: After having created a hierarchy with `hierarchy-new',
+;; populate it by calling `hierarchy-add-tree' or
+;; `hierarchy-add-trees'. You can then optionally sort its element
+;; with `hierarchy-sort'.
+
+;; Querying: You can learn more about your hierarchy by using
+;; functions such as `hierarchy-roots', `hierarchy-has-item',
+;; `hierarchy-length', `hierarchy-parent', `hierarchy-descendant-p'.
+
+;; Navigation: When your hierarchy is ready, you can use
+;; `hierarchy-map-item', `hierarchy-map', and `map-tree' to apply
+;; functions to elements of the hierarchy.
+
+;; Display: You can display a hierarchy as a tabulated list using
+;; `hierarchy-tabulated-display' and as an expandable/foldable tree
+;; using `hierarchy-convert-to-tree-widget'. The
+;; `hierarchy-labelfn-*' functions will help you display each item of
+;; the hierarchy the way you want it.
+
+;;; Limitation:
+
+;; - Current implementation uses #'equal to find and distinguish
+;; elements. Support for user-provided equality definition is
+;; desired but not yet implemented;
+;;
+;; - nil can't be added to a hierarchy;
+;;
+;; - the hierarchy is computed eagerly.
+
+;;; Code:
+
+(require 'seq)
+(require 'map)
+(require 'subr-x)
+(require 'cl-lib)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helpers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(cl-defstruct (hierarchy
+ (:constructor hierarchy--make)
+ (:conc-name hierarchy--))
+ (roots (list)) ; list of the hierarchy roots (no parent)
+ (parents (make-hash-table :test 'equal)) ; map an item to its parent
+ (children (make-hash-table :test 'equal)) ; map an item to its childre
+ ;; cache containing the set of all items in the hierarchy
+ (seen-items (make-hash-table :test 'equal))) ; map an item to t
+
+(defun hierarchy--seen-items-add (hierarchy item)
+ "In HIERARCHY, add ITEM to seen items."
+ (map-put! (hierarchy--seen-items hierarchy) item t))
+
+(defun hierarchy--compute-roots (hierarchy)
+ "Search roots of HIERARCHY and return them."
+ (cl-set-difference
+ (map-keys (hierarchy--seen-items hierarchy))
+ (map-keys (hierarchy--parents hierarchy))
+ :test #'equal))
+
+(defun hierarchy--sort-roots (hierarchy sortfn)
+ "Compute, sort and store the roots of HIERARCHY.
+
+SORTFN is a function taking two items of the hierarchy as parameter and
+returning non-nil if the first parameter is lower than the second."
+ (setf (hierarchy--roots hierarchy)
+ (sort (hierarchy--compute-roots hierarchy)
+ sortfn)))
+
+(defun hierarchy--add-relation (hierarchy item parent acceptfn)
+ "In HIERARCHY, add ITEM as child of PARENT.
+
+ACCEPTFN is a function returning non-nil if its parameter (any object)
+should be an item of the hierarchy."
+ (let* ((existing-parent (hierarchy-parent hierarchy item))
+ (has-parent-p (funcall acceptfn existing-parent)))
+ (cond
+ ((and has-parent-p (not (equal existing-parent parent)))
+ (error "An item (%s) can only have one parent: '%s' vs '%s'"
+ item existing-parent parent))
+ ((not has-parent-p)
+ (let ((existing-children (map-elt (hierarchy--children hierarchy)
+ parent (list))))
+ (map-put! (hierarchy--children hierarchy)
+ parent (append existing-children (list item))))
+ (map-put! (hierarchy--parents hierarchy) item parent)))))
+
+(defun hierarchy--set-equal (list1 list2 &rest cl-keys)
+ "Return non-nil if LIST1 and LIST2 have same elements.
+
+I.e., if every element of LIST1 also appears in LIST2 and if
+every element of LIST2 also appears in LIST1.
+
+CL-KEYS are key-value pairs just like in `cl-subsetp'. Supported
+keys are :key and :test."
+ (and (apply 'cl-subsetp list1 list2 cl-keys)
+ (apply 'cl-subsetp list2 list1 cl-keys)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Creation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun hierarchy-new ()
+ "Create a hierarchy and return it."
+ (hierarchy--make))
+
+(defun hierarchy-add-tree (hierarchy item parentfn &optional childrenfn acceptfn)
+ "In HIERARCHY, add ITEM.
+
+PARENTFN is either nil or a function defining the child-to-parent
+relationship: this function takes an item as parameter and should return
+the parent of this item in the hierarchy. If the item has no parent in the
+hierarchy (i.e., it should be a root), the function should return an object
+not accepted by acceptfn (i.e., nil for the default value of acceptfn).
+
+CHILDRENFN is either nil or a function defining the parent-to-children
+relationship: this function takes an item as parameter and should return a
+list of children of this item in the hierarchy.
+
+If both PARENTFN and CHILDRENFN are non-nil, the results of PARENTFN and
+CHILDRENFN are expected to be coherent with each other.
+
+ACCEPTFN is a function returning non-nil if its parameter (any object)
+should be an item of the hierarchy. By default, ACCEPTFN returns non-nil
+if its parameter is non-nil."
+ (unless (hierarchy-has-item hierarchy item)
+ (let ((acceptfn (or acceptfn #'identity)))
+ (hierarchy--seen-items-add hierarchy item)
+ (let ((parent (and parentfn (funcall parentfn item))))
+ (when (funcall acceptfn parent)
+ (hierarchy--add-relation hierarchy item parent acceptfn)
+ (hierarchy-add-tree hierarchy parent parentfn childrenfn)))
+ (let ((children (and childrenfn (funcall childrenfn item))))
+ (mapc (lambda (child)
+ (when (funcall acceptfn child)
+ (hierarchy--add-relation hierarchy child item acceptfn)
+ (hierarchy-add-tree hierarchy child parentfn childrenfn)))
+ children)))))
+
+(defun hierarchy-add-trees (hierarchy items parentfn &optional childrenfn acceptfn)
+ "Call `hierarchy-add-tree' on HIERARCHY and each element of ITEMS.
+
+PARENTFN, CHILDRENFN and ACCEPTFN have the same meaning as in `hierarchy-add'."
+ (seq-map (lambda (item)
+ (hierarchy-add-tree hierarchy item parentfn childrenfn acceptfn))
+ items))
+
+(defun hierarchy-add-list (hierarchy list &optional wrap childrenfn)
+ "Add to HIERARCHY the sub-lists in LIST.
+
+If WRAP is non-nil, allow duplicate items in LIST by wraping each
+item in a cons (id . item). The root's id is 1.
+
+CHILDRENFN is a function (defaults to `cdr') taking LIST as a
+parameter which should return LIST's children (a list). Each
+child is (recursively) passed as a parameter to CHILDRENFN to get
+its own children. Because of this parameter, LIST can be
+anything, not necessarily a list."
+ (let* ((childrenfn (or childrenfn #'cdr))
+ (id 0)
+ (wrapfn (lambda (item)
+ (if wrap
+ (cons (setq id (1+ id)) item)
+ item)))
+ (unwrapfn (if wrap #'cdr #'identity)))
+ (hierarchy-add-tree
+ hierarchy (funcall wrapfn list) nil
+ (lambda (item)
+ (mapcar wrapfn (funcall childrenfn
+ (funcall unwrapfn item)))))
+ hierarchy))
+
+(defun hierarchy-from-list (list &optional wrap childrenfn)
+ "Create and return a hierarchy built from LIST.
+
+This function passes LIST, WRAP and CHILDRENFN unchanged to
+`hierarchy-add-list'."
+ (hierarchy-add-list (hierarchy-new) list wrap childrenfn))
+
+(defun hierarchy-sort (hierarchy &optional sortfn)
+ "Modify HIERARCHY so that its roots and item's children are sorted.
+
+SORTFN is a function taking two items of the hierarchy as parameter and
+returning non-nil if the first parameter is lower than the second. By
+default, SORTFN is `string-lessp'."
+ (let ((sortfn (or sortfn #'string-lessp)))
+ (hierarchy--sort-roots hierarchy sortfn)
+ (mapc (lambda (parent)
+ (setf
+ (map-elt (hierarchy--children hierarchy) parent)
+ (sort (map-elt (hierarchy--children hierarchy) parent) sortfn)))
+ (map-keys (hierarchy--children hierarchy)))))
+
+(defun hierarchy-extract-tree (hierarchy item)
+ "Return a copy of HIERARCHY with ITEM's descendants and parents."
+ (if (not (hierarchy-has-item hierarchy item))
+ nil
+ (let ((tree (hierarchy-new)))
+ (hierarchy-add-tree tree item
+ (lambda (each) (hierarchy-parent hierarchy each))
+ (lambda (each)
+ (when (or (equal each item)
+ (hierarchy-descendant-p hierarchy each item))
+ (hierarchy-children hierarchy each))))
+ tree)))
+
+(defun hierarchy-copy (hierarchy)
+ "Return a copy of HIERARCHY.
+
+Items in HIERARCHY are shared, but structure is not."
+ (hierarchy-map-hierarchy (lambda (item _) (identity item)) hierarchy))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Querying
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun hierarchy-items (hierarchy)
+ "Return a list of all items of HIERARCHY."
+ (map-keys (hierarchy--seen-items hierarchy)))
+
+(defun hierarchy-has-item (hierarchy item)
+ "Return t if HIERARCHY includes ITEM."
+ (map-contains-key (hierarchy--seen-items hierarchy) item))
+
+(defun hierarchy-empty-p (hierarchy)
+ "Return t if HIERARCHY is empty."
+ (= 0 (hierarchy-length hierarchy)))
+
+(defun hierarchy-length (hierarchy)
+ "Return the number of items in HIERARCHY."
+ (hash-table-count (hierarchy--seen-items hierarchy)))
+
+(defun hierarchy-has-root (hierarchy item)
+ "Return t if one of HIERARCHY's roots is ITEM.
+
+A root is an item with no parent."
+ (seq-contains-p (hierarchy-roots hierarchy) item))
+
+(defun hierarchy-roots (hierarchy)
+ "Return all roots of HIERARCHY.
+
+A root is an item with no parent."
+ (let ((roots (hierarchy--roots hierarchy)))
+ (or roots
+ (hierarchy--compute-roots hierarchy))))
+
+(defun hierarchy-leafs (hierarchy &optional node)
+ "Return all leafs of HIERARCHY.
+
+A leaf is an item with no child.
+
+If NODE is an item of HIERARCHY, only return leafs under NODE."
+ (let ((leafs (cl-set-difference
+ (map-keys (hierarchy--seen-items hierarchy))
+ (map-keys (hierarchy--children hierarchy)))))
+ (if (hierarchy-has-item hierarchy node)
+ (seq-filter (lambda (item)
+ (hierarchy-descendant-p hierarchy item node))
+ leafs)
+ leafs)))
+
+(defun hierarchy-parent (hierarchy item)
+ "In HIERARCHY, return parent of ITEM."
+ (map-elt (hierarchy--parents hierarchy) item))
+
+(defun hierarchy-children (hierarchy parent)
+ "In HIERARCHY, return children of PARENT."
+ (map-elt (hierarchy--children hierarchy) parent (list)))
+
+(defun hierarchy-child-p (hierarchy item1 item2)
+ "In HIERARCHY, return non-nil if and only if ITEM1 is a child of ITEM2."
+ (equal (hierarchy-parent hierarchy item1) item2))
+
+(defun hierarchy-descendant-p (hierarchy item1 item2)
+ "In HIERARCHY, return non-nil if and only if ITEM1 is a descendant of ITEM2.
+
+ITEM1 is a descendant of ITEM2 if and only if both are items of HIERARCHY
+and either:
+
+- ITEM1 is child of ITEM2, or
+- ITEM1's parent is a descendant of ITEM2."
+ (and
+ (hierarchy-has-item hierarchy item1)
+ (hierarchy-has-item hierarchy item2)
+ (or
+ (hierarchy-child-p hierarchy item1 item2)
+ (hierarchy-descendant-p
+ hierarchy (hierarchy-parent hierarchy item1) item2))))
+
+(defun hierarchy-equal (hierarchy1 hierarchy2)
+ "Return t if HIERARCHY1 and HIERARCHY2 are equal.
+
+Two equal hierarchies share the same items and the same
+relationships among them."
+ (and (hierarchy-p hierarchy1)
+ (hierarchy-p hierarchy2)
+ (= (hierarchy-length hierarchy1) (hierarchy-length hierarchy2))
+ ;; parents are the same
+ (seq-every-p (lambda (child)
+ (equal (hierarchy-parent hierarchy1 child)
+ (hierarchy-parent hierarchy2 child)))
+ (map-keys (hierarchy--parents hierarchy1)))
+ ;; children are the same
+ (seq-every-p (lambda (parent)
+ (hierarchy--set-equal
+ (hierarchy-children hierarchy1 parent)
+ (hierarchy-children hierarchy2 parent)
+ :test #'equal))
+ (map-keys (hierarchy--children hierarchy1)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Navigation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun hierarchy-map-item (func item hierarchy &optional indent)
+ "Return the result of applying FUNC to ITEM and its descendants in HIERARCHY.
+
+This function navigates the tree top-down: FUNCTION is first called on item
+and then on each of its children. Results are concatenated in a list.
+
+INDENT is a number (default 0) representing the indentation of ITEM in
+HIERARCHY. FUNC should take 2 argument: the item and its indentation
+level."
+ (let ((indent (or indent 0)))
+ (cons
+ (funcall func item indent)
+ (seq-mapcat (lambda (child) (hierarchy-map-item func child
+ hierarchy (1+ indent)))
+ (hierarchy-children hierarchy item)))))
+
+(defun hierarchy-map (func hierarchy &optional indent)
+ "Return the result of applying FUNC to each element of HIERARCHY.
+
+This function navigates the tree top-down: FUNCTION is first called on each
+root. To do so, it calls `hierarchy-map-item' on each root
+sequentially. Results are concatenated in a list.
+
+FUNC should take 2 arguments: the item and its indentation level.
+
+INDENT is a number (default 0) representing the indentation of HIERARCHY's
+roots."
+ (let ((indent (or indent 0)))
+ (seq-mapcat (lambda (root) (hierarchy-map-item func root hierarchy indent))
+ (hierarchy-roots hierarchy))))
+
+(defun hierarchy-map-tree (function hierarchy &optional item indent)
+ "Apply FUNCTION on each item of HIERARCHY under ITEM.
+
+This function navigates the tree bottom-up: FUNCTION is first called on
+leafs and the result is passed as parameter when calling FUNCTION on
+parents.
+
+FUNCTION should take 3 parameters: the current item, its indentation
+level (a number), and a list representing the result of applying
+`hierarchy-map-tree' to each child of the item.
+
+INDENT is 0 by default and is passed as second parameter to FUNCTION.
+INDENT is incremented by 1 at each level of the tree.
+
+This function returns the result of applying FUNCTION to ITEM (the first
+root if nil)."
+ (let ((item (or item (car (hierarchy-roots hierarchy))))
+ (indent (or indent 0)))
+ (funcall function item indent
+ (mapcar (lambda (child)
+ (hierarchy-map-tree function hierarchy
+ child (1+ indent)))
+ (hierarchy-children hierarchy item)))))
+
+(defun hierarchy-map-hierarchy (function hierarchy)
+ "Apply FUNCTION to each item of HIERARCHY in a new hierarchy.
+
+FUNCTION should take 2 parameters, the current item and its
+indentation level (a number), and should return an item to be
+added to the new hierarchy."
+ (let* ((items (make-hash-table :test #'equal))
+ (transform (lambda (item) (map-elt items item))))
+ ;; Make 'items', a table mapping original items to their
+ ;; transformation
+ (hierarchy-map (lambda (item indent)
+ (map-put! items item (funcall function item indent)))
+ hierarchy)
+ (hierarchy--make
+ :roots (mapcar transform (hierarchy-roots hierarchy))
+ :parents (let ((result (make-hash-table :test #'equal)))
+ (map-apply (lambda (child parent)
+ (map-put! result
+ (funcall transform child)
+ (funcall transform parent)))
+ (hierarchy--parents hierarchy))
+ result)
+ :children (let ((result (make-hash-table :test #'equal)))
+ (map-apply (lambda (parent children)
+ (map-put! result
+ (funcall transform parent)
+ (seq-map transform children)))
+ (hierarchy--children hierarchy))
+ result)
+ :seen-items (let ((result (make-hash-table :test #'equal)))
+ (map-apply (lambda (item v)
+ (map-put! result
+ (funcall transform item)
+ v))
+ (hierarchy--seen-items hierarchy))
+ result))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Display
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun hierarchy-labelfn-indent (labelfn &optional indent-string)
+ "Return a function rendering LABELFN indented with INDENT-STRING.
+
+INDENT-STRING defaults to a 2-space string. Indentation is
+multiplied by the depth of the displayed item."
+ (let ((indent-string (or indent-string " ")))
+ (lambda (item indent)
+ (dotimes (_ indent) (insert indent-string))
+ (funcall labelfn item indent))))
+
+(defun hierarchy-labelfn-button (labelfn actionfn)
+ "Return a function rendering LABELFN in a button.
+
+Clicking the button triggers ACTIONFN. ACTIONFN is a function
+taking an item of HIERARCHY and an indentation value (a number)
+as input. This function is called when an item is clicked. The
+return value of ACTIONFN is ignored."
+ (lambda (item indent)
+ (let ((start (point)))
+ (funcall labelfn item indent)
+ (make-text-button start (point)
+ 'action (lambda (_) (funcall actionfn item indent))))))
+
+(defun hierarchy-labelfn-button-if (labelfn buttonp actionfn)
+ "Return a function rendering LABELFN as a button if BUTTONP.
+
+Pass LABELFN and ACTIONFN to `hierarchy-labelfn-button' if
+BUTTONP is non-nil. Otherwise, render LABELFN without making it
+a button.
+
+BUTTONP is a function taking an item of HIERARCHY and an
+indentation value (a number) as input."
+ (lambda (item indent)
+ (if (funcall buttonp item indent)
+ (funcall (hierarchy-labelfn-button labelfn actionfn) item indent)
+ (funcall labelfn item indent))))
+
+(defun hierarchy-labelfn-to-string (labelfn item indent)
+ "Execute LABELFN on ITEM and INDENT. Return result as a string."
+ (with-temp-buffer
+ (funcall labelfn item indent)
+ (buffer-substring (point-min) (point-max))))
+
+(defun hierarchy-print (hierarchy &optional to-string)
+ "Insert HIERARCHY in current buffer as plain text.
+
+Use TO-STRING to convert each element to a string. TO-STRING is
+a function taking an item of HIERARCHY as input and returning a
+string. If nil, TO-STRING defaults to a call to `format' with \"%s\"."
+ (let ((to-string (or to-string (lambda (item) (format "%s" item)))))
+ (hierarchy-map
+ (hierarchy-labelfn-indent (lambda (item _)
+ (insert (funcall to-string item) "\n")))
+ hierarchy)))
+
+(defun hierarchy-to-string (hierarchy &optional to-string)
+ "Return a string representing HIERARCHY.
+
+TO-STRING is passed unchanged to `hierarchy-print'."
+ (with-temp-buffer
+ (hierarchy-print hierarchy to-string)
+ (buffer-substring (point-min) (point-max))))
+
+(defun hierarchy-tabulated-imenu-action (_item-name position)
+ "Move to ITEM-NAME at POSITION in current buffer."
+ (goto-char position)
+ (back-to-indentation))
+
+(define-derived-mode hierarchy-tabulated-mode tabulated-list-mode "Hierarchy tabulated"
+ "Major mode to display a hierarchy as a tabulated list."
+ (setq-local imenu-generic-expression
+ ;; debbugs: 26457 - Cannot pass a function to
+ ;; imenu-generic-expression. Add
+ ;; `hierarchy-tabulated-imenu-action' to the end of the
+ ;; list when bug is fixed
+ '(("Item" "^[[:space:]]+\\(?1:.+\\)$" 1))))
+
+(defun hierarchy-tabulated-display (hierarchy labelfn &optional buffer)
+ "Display HIERARCHY as a tabulated list in `hierarchy-tabulated-mode'.
+
+LABELFN is a function taking an item of HIERARCHY and an indentation
+level (a number) as input and inserting a string to be displayed in the
+table.
+
+The tabulated list is displayed in BUFFER, or a newly created buffer if
+nil. The buffer is returned."
+ (let ((buffer (or buffer (generate-new-buffer "hierarchy-tabulated"))))
+ (with-current-buffer buffer
+ (hierarchy-tabulated-mode)
+ (setq tabulated-list-format
+ (vector '("Item name" 0 nil)))
+ (setq tabulated-list-entries
+ (hierarchy-map (lambda (item indent)
+ (list item (vector (hierarchy-labelfn-to-string
+ labelfn item indent))))
+ hierarchy))
+ (tabulated-list-init-header)
+ (tabulated-list-print))
+ buffer))
+
+(declare-function widget-convert "wid-edit")
+(defun hierarchy-convert-to-tree-widget (hierarchy labelfn)
+ "Return a tree-widget for HIERARCHY.
+
+LABELFN is a function taking an item of HIERARCHY and an indentation
+value (a number) as parameter and inserting a string to be displayed as a
+node label."
+ (require 'wid-edit)
+ (require 'tree-widget)
+ (hierarchy-map-tree (lambda (item indent children)
+ (widget-convert
+ 'tree-widget
+ :tag (hierarchy-labelfn-to-string labelfn item indent)
+ :args children))
+ hierarchy))
+
+(defun hierarchy-tree-display (hierarchy labelfn &optional buffer)
+ "Display HIERARCHY as a tree widget in a new buffer.
+
+HIERARCHY and LABELFN are passed unchanged to
+`hierarchy-convert-to-tree-widget'.
+
+The tree widget is displayed in BUFFER, or a newly created buffer if
+nil. The buffer is returned."
+ (let ((buffer (or buffer (generate-new-buffer "*hierarchy-tree*")))
+ (tree-widget (hierarchy-convert-to-tree-widget hierarchy labelfn)))
+ (with-current-buffer buffer
+ (setq-local buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (widget-create tree-widget)
+ (goto-char (point-min))
+ (special-mode)))
+ buffer))
+
+(provide 'hierarchy)
+
+;;; hierarchy.el ends here
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index ceb9b6bea5f..0d57bc16a3a 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -485,7 +485,18 @@ absent, return nil."
(lm-with-file file
(let ((start (lm-commentary-start)))
(when start
- (buffer-substring-no-properties start (lm-commentary-end))))))
+ (replace-regexp-in-string ; Get rid of...
+ "[[:blank:]]*$" "" ; trailing white-space
+ (replace-regexp-in-string
+ (format "%s\\|%s\\|%s"
+ ;; commentary header
+ (concat "^;;;[[:blank:]]*\\("
+ lm-commentary-header
+ "\\):[[:blank:]\n]*")
+ "^;;[[:blank:]]*" ; double semicolon prefix
+ "[[:blank:]\n]*\\'") ; trailing new-lines
+ "" (buffer-substring-no-properties
+ start (lm-commentary-end))))))))
(defun lm-homepage (&optional file)
"Return the homepage in file FILE, or current buffer if FILE is nil."
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index fa857cd4c6b..cc40af7a41c 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -178,13 +178,16 @@
(defun lisp--match-hidden-arg (limit)
(let ((res nil))
+ (forward-line 0)
(while
- (let ((ppss (parse-partial-sexp (line-beginning-position)
+ (let ((ppss (parse-partial-sexp (point)
(line-end-position)
-1)))
(skip-syntax-forward " )")
(if (or (>= (car ppss) 0)
- (looking-at ";\\|$"))
+ (eolp)
+ (looking-at ";")
+ (nth 8 (syntax-ppss))) ;Within a string or comment.
(progn
(forward-line 1)
(< (point) limit))
@@ -200,7 +203,9 @@
(save-excursion
(ignore-errors
(goto-char pos)
- (or (eql (char-before) ?\')
+ ;; '(lambda ..) is not a funcall position, but #'(lambda ...) is.
+ (or (and (eql (char-before) ?\')
+ (not (eql (char-before (1- (point))) ?#)))
(let* ((ppss (syntax-ppss))
(paren-posns (nth 9 ppss))
(parent
@@ -456,7 +461,7 @@ This will generate compile-time constants from BINDINGS."
(,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
(0 font-lock-builtin-face))
;; ELisp and CLisp `&' keywords as types.
- (,(concat "\\_<\\&" lisp-mode-symbol-regexp "\\_>")
+ (,(concat "\\_<&" lisp-mode-symbol-regexp "\\_>")
. font-lock-type-face)
;; ELisp regexp grouping constructs
(,(lambda (bound)
@@ -476,7 +481,8 @@ This will generate compile-time constants from BINDINGS."
(3 'font-lock-regexp-grouping-construct prepend))
(lisp--match-hidden-arg
(0 '(face font-lock-warning-face
- help-echo "Hidden behind deeper element; move to another line?")))
+ help-echo "Easy to misread; consider moving the element to the next line")
+ prepend))
(lisp--match-confusable-symbol-character
0 '(face font-lock-warning-face
help-echo "Confusable character"))
@@ -504,14 +510,12 @@ This will generate compile-time constants from BINDINGS."
(1 font-lock-constant-face prepend))
;; Uninterned symbols, e.g., (defpackage #:my-package ...)
;; must come before keywords below to have effect
- (,(concat "\\(#:\\)\\(" lisp-mode-symbol-regexp "\\)")
- (1 font-lock-comment-delimiter-face)
- (2 font-lock-doc-face))
+ (,(concat "#:" lisp-mode-symbol-regexp "") 0 font-lock-builtin-face)
;; Constant values.
(,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
(0 font-lock-builtin-face))
;; ELisp and CLisp `&' keywords as types.
- (,(concat "\\_<\\&" lisp-mode-symbol-regexp "\\_>")
+ (,(concat "\\_<&" lisp-mode-symbol-regexp "\\_>")
. font-lock-type-face)
;; This is too general -- rms.
;; A user complained that he has functions whose names start with `do'
@@ -522,7 +526,8 @@ This will generate compile-time constants from BINDINGS."
(1 font-lock-keyword-face))
(lisp--match-hidden-arg
(0 '(face font-lock-warning-face
- help-echo "Hidden behind deeper element; move to another line?")))
+ help-echo "Easy to misread; consider moving the element to the next line")
+ prepend))
))
"Gaudy level highlighting for Lisp modes.")))
@@ -611,6 +616,8 @@ Value for `adaptive-fill-function'."
;; a single docstring. Let's fix it here.
(if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") ""))
+;; Maybe this should be discouraged/obsoleted and users should be
+;; encouraged to use `lisp-data-mode` instead.
(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive
elisp)
"Common initialization routine for lisp modes.
@@ -658,6 +665,14 @@ font-lock keywords will not be case sensitive."
(setq-local electric-pair-skip-whitespace 'chomp)
(setq-local electric-pair-open-newline-between-pairs nil))
+;;;###autoload
+(define-derived-mode lisp-data-mode prog-mode "Lisp-Data"
+ "Major mode for buffers holding data written in Lisp syntax."
+ :group 'lisp
+ (lisp-mode-variables t t nil)
+ (setq-local electric-quote-string t)
+ (setq imenu-case-fold-search nil))
+
(defun lisp-outline-level ()
"Lisp mode `outline-level' function."
(let ((len (- (match-end 0) (match-beginning 0))))
@@ -737,7 +752,7 @@ font-lock keywords will not be case sensitive."
"Keymap for ordinary Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
-(define-derived-mode lisp-mode prog-mode "Lisp"
+(define-derived-mode lisp-mode lisp-data-mode "Lisp"
"Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
Commands:
Delete converts tabs to spaces as it moves back.
@@ -746,10 +761,10 @@ Blank lines separate paragraphs. Semicolons start comments.
\\{lisp-mode-map}
Note that `run-lisp' may be used either to start an inferior Lisp job
or to switch back to an existing one."
- (lisp-mode-variables nil t)
+ (setq-local lisp-indent-function 'common-lisp-indent-function)
(setq-local find-tag-default-function 'lisp-find-tag-default)
(setq-local comment-start-skip
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
(setq imenu-case-fold-search t))
(defun lisp-find-tag-default ()
@@ -775,8 +790,6 @@ or to switch back to an existing one."
nil)))
(comment-indent-default)))
-(define-obsolete-function-alias 'lisp-mode-auto-fill 'do-auto-fill "23.1")
-
(defcustom lisp-indent-offset nil
"If non-nil, indent second line of expressions that many more columns."
:group 'lisp
@@ -946,6 +959,7 @@ is the buffer position of the start of the containing expression."
;; setting this to a number inhibits calling hook
(desired-indent nil)
(retry t)
+ whitespace-after-open-paren
calculate-lisp-indent-last-sexp containing-sexp)
(cond ((or (markerp parse-start) (integerp parse-start))
(goto-char parse-start))
@@ -975,6 +989,7 @@ is the buffer position of the start of the containing expression."
nil
;; Innermost containing sexp found
(goto-char (1+ containing-sexp))
+ (setq whitespace-after-open-paren (looking-at (rx whitespace)))
(if (not calculate-lisp-indent-last-sexp)
;; indent-point immediately follows open paren.
;; Don't call hook.
@@ -989,9 +1004,11 @@ is the buffer position of the start of the containing expression."
calculate-lisp-indent-last-sexp)
;; This is the first line to start within the containing sexp.
;; It's almost certainly a function call.
- (if (= (point) calculate-lisp-indent-last-sexp)
+ (if (or (= (point) calculate-lisp-indent-last-sexp)
+ whitespace-after-open-paren)
;; Containing sexp has nothing before this line
- ;; except the first element. Indent under that element.
+ ;; except the first element, or the first element is
+ ;; preceded by whitespace. Indent under that element.
nil
;; Skip the first element, find start of second (the first
;; argument of the function call) and indent under.
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 043cf01d2e9..124900168c3 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -55,7 +55,7 @@ This affects `insert-parentheses' and `insert-pair'."
"If non-nil, `forward-sexp' delegates to this function.
Should take the same arguments and behave similarly to `forward-sexp'.")
-(defun forward-sexp (&optional arg)
+(defun forward-sexp (&optional arg interactive)
"Move forward across one balanced expression (sexp).
With ARG, do it that many times. Negative arg -N means move
backward across N balanced expressions. This command assumes
@@ -64,23 +64,32 @@ point is not in a string or comment. Calls
If unable to move over a sexp, signal `scan-error' with three
arguments: a message, the start of the obstacle (usually a
parenthesis or list marker of some kind), and end of the
-obstacle."
- (interactive "^p")
- (or arg (setq arg 1))
- (if forward-sexp-function
- (funcall forward-sexp-function arg)
- (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
- (if (< arg 0) (backward-prefix-chars))))
-
-(defun backward-sexp (&optional arg)
+obstacle. If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
+ (if interactive
+ (condition-case _
+ (forward-sexp arg nil)
+ (scan-error (user-error (if (> arg 0)
+ "No next sexp"
+ "No previous sexp"))))
+ (or arg (setq arg 1))
+ (if forward-sexp-function
+ (funcall forward-sexp-function arg)
+ (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
+ (if (< arg 0) (backward-prefix-chars)))))
+
+(defun backward-sexp (&optional arg interactive)
"Move backward across one balanced expression (sexp).
With ARG, do it that many times. Negative arg -N means
move forward across N balanced expressions.
This command assumes point is not in a string or comment.
-Uses `forward-sexp' to do the work."
- (interactive "^p")
+Uses `forward-sexp' to do the work.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
(or arg (setq arg 1))
- (forward-sexp (- arg)))
+ (forward-sexp (- arg) interactive))
(defun mark-sexp (&optional arg allow-extend)
"Set mark ARG sexps from point.
@@ -99,50 +108,78 @@ This command assumes point is not in a string or comment."
(set-mark
(save-excursion
(goto-char (mark))
- (forward-sexp arg)
+ (condition-case error
+ (forward-sexp arg)
+ (scan-error
+ (user-error (if (equal (cadr error)
+ "Containing expression ends prematurely")
+ "No more sexp to select"
+ (cadr error)))))
(point))))
(t
(push-mark
(save-excursion
- (forward-sexp (prefix-numeric-value arg))
+ (condition-case error
+ (forward-sexp (prefix-numeric-value arg))
+ (scan-error
+ (user-error (if (equal (cadr error)
+ "Containing expression ends prematurely")
+ "No sexp to select"
+ (cadr error)))))
(point))
nil t))))
-(defun forward-list (&optional arg)
+(defun forward-list (&optional arg interactive)
"Move forward across one balanced group of parentheses.
This command will also work on other parentheses-like expressions
defined by the current language mode.
With ARG, do it that many times.
Negative arg -N means move backward across N groups of parentheses.
-This command assumes point is not in a string or comment."
- (interactive "^p")
- (or arg (setq arg 1))
- (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
-
-(defun backward-list (&optional arg)
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
+ (if interactive
+ (condition-case _
+ (forward-list arg nil)
+ (scan-error (user-error (if (> arg 0)
+ "No next group"
+ "No previous group"))))
+ (or arg (setq arg 1))
+ (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))))
+
+(defun backward-list (&optional arg interactive)
"Move backward across one balanced group of parentheses.
This command will also work on other parentheses-like expressions
defined by the current language mode.
With ARG, do it that many times.
Negative arg -N means move forward across N groups of parentheses.
-This command assumes point is not in a string or comment."
- (interactive "^p")
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
(or arg (setq arg 1))
- (forward-list (- arg)))
+ (forward-list (- arg) interactive))
-(defun down-list (&optional arg)
+(defun down-list (&optional arg interactive)
"Move forward down one level of parentheses.
This command will also work on other parentheses-like expressions
defined by the current language mode.
With ARG, do this that many times.
A negative argument means move backward but still go down a level.
-This command assumes point is not in a string or comment."
- (interactive "^p")
- (or arg (setq arg 1))
- (let ((inc (if (> arg 0) 1 -1)))
- (while (/= arg 0)
- (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
- (setq arg (- arg inc)))))
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
+ (if interactive
+ (condition-case _
+ (down-list arg nil)
+ (scan-error (user-error "At bottom level")))
+ (or arg (setq arg 1))
+ (let ((inc (if (> arg 0) 1 -1)))
+ (while (/= arg 0)
+ (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
+ (setq arg (- arg inc))))))
(defun backward-up-list (&optional arg escape-strings no-syntax-crossing)
"Move backward out of one level of parentheses.
@@ -229,26 +266,39 @@ point is unspecified."
(or (< inc 0)
(forward-comment 1))
(setf arg (+ arg inc)))
- (signal (car err) (cdr err))))))
+ (if no-syntax-crossing
+ ;; Assume called interactively; don't signal an error.
+ (user-error "At top level")
+ (signal (car err) (cdr err)))))))
(setq arg (- arg inc)))))
-(defun kill-sexp (&optional arg)
+(defun kill-sexp (&optional arg interactive)
"Kill the sexp (balanced expression) following point.
With ARG, kill that many sexps after point.
Negative arg -N means kill N sexps before point.
-This command assumes point is not in a string or comment."
- (interactive "p")
- (let ((opoint (point)))
- (forward-sexp (or arg 1))
- (kill-region opoint (point))))
-
-(defun backward-kill-sexp (&optional arg)
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "p\nd")
+ (if interactive
+ (condition-case _
+ (kill-sexp arg nil)
+ (scan-error (user-error (if (> arg 0)
+ "No next sexp"
+ "No previous sexp"))))
+ (let ((opoint (point)))
+ (forward-sexp (or arg 1))
+ (kill-region opoint (point)))))
+
+(defun backward-kill-sexp (&optional arg interactive)
"Kill the sexp (balanced expression) preceding point.
With ARG, kill that many sexps before point.
Negative arg -N means kill N sexps after point.
-This command assumes point is not in a string or comment."
- (interactive "p")
- (kill-sexp (- (or arg 1))))
+This command assumes point is not in a string or comment.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "p\nd")
+ (kill-sexp (- (or arg 1)) interactive))
;; After Zmacs:
(defun kill-backward-up-list (&optional arg)
@@ -482,7 +532,8 @@ is called as a function to find the defun's end."
(if (looking-at "\\s<\\|\n")
(forward-line 1))))))
(funcall end-of-defun-function)
- (funcall skip)
+ (when (<= arg 1)
+ (funcall skip))
(cond
((> arg 0)
;; Moving forward.
@@ -733,13 +784,52 @@ This command assumes point is not in a string or comment."
(interactive "P")
(insert-pair arg ?\( ?\)))
+(defcustom delete-pair-blink-delay blink-matching-delay
+ "Time in seconds to delay after showing a paired character to delete.
+It's used by the command `delete-pair'. The value 0 disables blinking."
+ :type 'number
+ :group 'lisp
+ :version "28.1")
+
(defun delete-pair (&optional arg)
- "Delete a pair of characters enclosing ARG sexps following point.
-A negative ARG deletes a pair of characters around preceding ARG sexps."
- (interactive "p")
- (unless arg (setq arg 1))
- (save-excursion (forward-sexp arg) (delete-char (if (> arg 0) -1 1)))
- (delete-char (if (> arg 0) 1 -1)))
+ "Delete a pair of characters enclosing ARG sexps that follow point.
+A negative ARG deletes a pair around the preceding ARG sexps instead.
+The option `delete-pair-blink-delay' can disable blinking."
+ (interactive "P")
+ (if arg
+ (setq arg (prefix-numeric-value arg))
+ (setq arg 1))
+ (if (< arg 0)
+ (save-excursion
+ (skip-chars-backward " \t")
+ (save-excursion
+ (let ((close-char (char-before)))
+ (forward-sexp arg)
+ (unless (member (list (char-after) close-char)
+ (mapcar (lambda (p)
+ (if (= (length p) 3) (cdr p) p))
+ insert-pair-alist))
+ (error "Not after matching pair"))
+ (when (and (numberp delete-pair-blink-delay)
+ (> delete-pair-blink-delay 0))
+ (sit-for delete-pair-blink-delay))
+ (delete-char 1)))
+ (delete-char -1))
+ (save-excursion
+ (skip-chars-forward " \t")
+ (save-excursion
+ (let ((open-char (char-after)))
+ (forward-sexp arg)
+ (unless (member (list open-char (char-before))
+ (mapcar (lambda (p)
+ (if (= (length p) 3) (cdr p) p))
+ insert-pair-alist))
+ (error "Not before matching pair"))
+ (when (and (numberp delete-pair-blink-delay)
+ (> delete-pair-blink-delay 0))
+ (sit-for delete-pair-blink-delay))
+ (delete-char -1)))
+ (delete-char 1))))
(defun raise-sexp (&optional arg)
"Raise ARG sexps higher up the tree."
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 67f5b3cf24e..9c23344baca 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -4,7 +4,7 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: convenience, map, hash-table, alist, array
-;; Version: 2.0
+;; Version: 2.1
;; Package-Requires: ((emacs "25"))
;; Package: map
@@ -56,8 +56,10 @@ evaluated and searched for in the map. The match fails if for any KEY
found in the map, the corresponding PAT doesn't match the value
associated to the KEY.
-Each element can also be a SYMBOL, which is an abbreviation of a (KEY
-PAT) tuple of the form (\\='SYMBOL SYMBOL).
+Each element can also be a SYMBOL, which is an abbreviation of
+a (KEY PAT) tuple of the form (\\='SYMBOL SYMBOL). When SYMBOL
+is a keyword, it is an abbreviation of the form (:SYMBOL SYMBOL),
+useful for binding plist values.
Keys in ARGS not found in the map are ignored, and the match doesn't
fail."
@@ -486,9 +488,12 @@ Example:
(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)) ,(cadr elt))
- `(app (pcase--flip map-elt ',elt) ,elt)))
+ (cond ((consp elt)
+ `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt)))
+ ((keywordp elt)
+ (let ((var (intern (substring (symbol-name elt) 1))))
+ `(app (pcase--flip map-elt ,elt) ,var)))
+ (t `(app (pcase--flip map-elt ',elt) ,elt))))
args))
(defun map--make-pcase-patterns (args)
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 85a15c96be5..b779aa27888 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -5,18 +5,20 @@
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions, lisp, tools
-;; This program is free software; you can redistribute it and/or modify
+;; 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.
-;; This program is distributed in the hope that it will be useful,
+;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 504eb99eb1d..fbab6debd5d 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -397,6 +397,26 @@ synchronously."
:type 'boolean
:version "25.1")
+(defcustom package-name-column-width 30
+ "Column width for the Package name in the package menu."
+ :type 'number
+ :version "28.1")
+
+(defcustom package-version-column-width 14
+ "Column width for the Package version in the package menu."
+ :type 'number
+ :version "28.1")
+
+(defcustom package-status-column-width 12
+ "Column width for the Package status in the package menu."
+ :type 'number
+ :version "28.1")
+
+(defcustom package-archive-column-width 8
+ "Column width for the Package status in the package menu."
+ :type 'number
+ :version "28.1")
+
;;; `package-desc' object definition
;; This is the struct used internally to represent packages.
@@ -421,9 +441,9 @@ synchronously."
&aux
(name (intern name-string))
(version (version-to-list version-string))
- (reqs (mapcar #'(lambda (elt)
- (list (car elt)
- (version-to-list (cadr elt))))
+ (reqs (mapcar (lambda (elt)
+ (list (car elt)
+ (version-to-list (cadr elt))))
(if (eq 'quote (car requirements))
(nth 1 requirements)
requirements)))
@@ -670,9 +690,9 @@ updates `package-alist'."
(progn (package-load-all-descriptors)
package-alist)))
-(defun define-package (_name-string _version-string
- &optional _docstring _requirements
- &rest _extra-properties)
+(defun define-package ( _name-string _version-string
+ &optional _docstring _requirements
+ &rest _extra-properties)
"Define a new package.
NAME-STRING is the name of the package, as a string.
VERSION-STRING is the version of the package, as a string.
@@ -798,7 +818,7 @@ correspond to previously loaded files (those returned by
;; FIXME: not the friendliest, but simple.
(require 'info)
(info-initialize)
- (push pkg-dir Info-directory-list))
+ (add-to-list 'Info-directory-list pkg-dir))
(push name package-activated-list)
;; Don't return nil.
t)))
@@ -926,7 +946,6 @@ untar into a directory named DIR; otherwise, signal an error."
(if (> (length file-list) 1) 'tar 'single))))
('tar
(make-directory package-user-dir t)
- ;; FIXME: should we delete PKG-DIR if it exists?
(let* ((default-directory (file-name-as-directory package-user-dir)))
(package-untar-buffer dirname)))
('single
@@ -995,7 +1014,6 @@ untar into a directory named DIR; otherwise, signal an error."
(write-region (autoload-rubric file "package" nil) nil file nil 'silent))
file)
-(defvar generated-autoload-file)
(defvar autoload-timestamps)
(defvar version-control)
@@ -1003,14 +1021,14 @@ untar into a directory named DIR; otherwise, signal an error."
"Generate autoloads in PKG-DIR for package named NAME."
(let* ((auto-name (format "%s-autoloads.el" name))
;;(ignore-name (concat name "-pkg.el"))
- (generated-autoload-file (expand-file-name auto-name pkg-dir))
+ (output-file (expand-file-name auto-name pkg-dir))
;; We don't need 'em, and this makes the output reproducible.
(autoload-timestamps nil)
(backup-inhibited t)
(version-control 'never))
- (package-autoload-ensure-default-file generated-autoload-file)
- (update-directory-autoloads pkg-dir)
- (let ((buf (find-buffer-visiting generated-autoload-file)))
+ (package-autoload-ensure-default-file output-file)
+ (make-directory-autoloads pkg-dir output-file)
+ (let ((buf (find-buffer-visiting output-file)))
(when buf (kill-buffer buf)))
auto-name))
@@ -1201,8 +1219,8 @@ The return result is a `package-desc'."
cipher-algorithm
digest-algorithm
compress-algorithm))
-(declare-function epg-verify-string "epg" (context signature
- &optional signed-text))
+(declare-function epg-verify-string "epg" ( context signature
+ &optional signed-text))
(declare-function epg-context-result-for "epg" (context name))
(declare-function epg-signature-status "epg" (signature) t)
(declare-function epg-signature-to-string "epg" (signature))
@@ -2083,7 +2101,8 @@ to install it but still mark it as selected."
(package-compute-transaction () (list (list pkg))))))
(progn
(package-download-transaction transaction)
- (package--quickstart-maybe-refresh))
+ (package--quickstart-maybe-refresh)
+ (message "Package `%s' installed." name))
(message "`%s' is already installed" name))))
(defun package-strip-rcs-id (str)
@@ -2134,6 +2153,7 @@ Downloads and installs required packages as needed."
(unless (package--user-selected-p name)
(package--save-selected-packages
(cons name package-selected-packages)))
+ (package--quickstart-maybe-refresh)
pkg-desc))
;;;###autoload
@@ -2319,10 +2339,7 @@ will be deleted."
(setq guess nil))
(setq packages (mapcar #'symbol-name packages))
(let ((val
- (completing-read (if guess
- (format "Describe package (default %s): "
- guess)
- "Describe package: ")
+ (completing-read (format-prompt "Describe package" guess)
packages nil t nil nil (when guess
(symbol-name guess)))))
(list (and (> (length val) 0) (intern val)))))))
@@ -2378,18 +2395,9 @@ The description is read from the installed package files."
result
;; Look for Commentary header.
- (let ((mainsrcfile (expand-file-name (format "%s.el" (package-desc-name desc))
- srcdir)))
- (when (file-readable-p mainsrcfile)
- (with-temp-buffer
- (insert (or (lm-commentary mainsrcfile) ""))
- (goto-char (point-min))
- (when (re-search-forward "^;;; Commentary:\n" nil t)
- (replace-match ""))
- (while (re-search-forward "^\\(;+ ?\\)" nil t)
- (replace-match ""))
- (buffer-string))))
- )))
+ (lm-commentary (expand-file-name
+ (format "%s.el" (package-desc-name desc)) srcdir))
+ "")))
(defun describe-package-1 (pkg)
"Insert the package description for PKG.
@@ -2584,16 +2592,10 @@ Helper function for `describe-package'."
(if built-in
;; For built-in packages, get the description from the
;; Commentary header.
- (let ((fn (locate-file (format "%s.el" name) load-path
- load-file-rep-suffixes))
- (opoint (point)))
- (insert (or (lm-commentary fn) ""))
- (save-excursion
- (goto-char opoint)
- (when (re-search-forward "^;;; Commentary:\n" nil t)
- (replace-match ""))
- (while (re-search-forward "^\\(;+ ?\\)" nil t)
- (replace-match ""))))
+ (insert (or (lm-commentary (locate-file (format "%s.el" name)
+ load-path
+ load-file-rep-suffixes))
+ ""))
(if (package-installed-p desc)
;; For installed packages, get the description from the
@@ -2630,8 +2632,7 @@ Used for the `action' property of buttons in the buffer created by
(when (y-or-n-p (format-message "Install package `%s'? "
(package-desc-full-name pkg-desc)))
(package-install pkg-desc nil)
- (revert-buffer nil t)
- (goto-char (point-min)))))
+ (describe-package (package-desc-name pkg-desc)))))
(defun package-delete-button-action (button)
"Run `package-delete' on the package BUTTON points to.
@@ -2641,8 +2642,7 @@ Used for the `action' property of buttons in the buffer created by
(when (y-or-n-p (format-message "Delete package `%s'? "
(package-desc-full-name pkg-desc)))
(package-delete pkg-desc)
- (revert-buffer nil t)
- (goto-char (point-min)))))
+ (describe-package (package-desc-name pkg-desc)))))
(defun package-keyword-button-action (button)
"Show filtered \"*Packages*\" buffer for BUTTON.
@@ -2696,15 +2696,20 @@ either a full name or nil, and EMAIL is a valid email address."
(define-key map "i" 'package-menu-mark-install)
(define-key map "U" 'package-menu-mark-upgrades)
(define-key map "r" 'revert-buffer)
- (define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
- (define-key map (kbd "/ n") 'package-menu-filter-by-name)
- (define-key map (kbd "/ /") 'package-menu-clear-filter)
(define-key map "~" 'package-menu-mark-obsolete-for-deletion)
(define-key map "x" 'package-menu-execute)
(define-key map "h" 'package-menu-quick-help)
(define-key map "H" #'package-menu-hide-package)
(define-key map "?" 'package-menu-describe-package)
(define-key map "(" #'package-menu-toggle-hiding)
+ (define-key map (kbd "/ /") 'package-menu-clear-filter)
+ (define-key map (kbd "/ a") 'package-menu-filter-by-archive)
+ (define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
+ (define-key map (kbd "/ n") 'package-menu-filter-by-name)
+ (define-key map (kbd "/ s") 'package-menu-filter-by-status)
+ (define-key map (kbd "/ v") 'package-menu-filter-by-version)
+ (define-key map (kbd "/ m") 'package-menu-filter-marked)
+ (define-key map (kbd "/ u") 'package-menu-filter-upgradable)
map)
"Local keymap for `package-menu-mode' buffers.")
@@ -2730,8 +2735,12 @@ either a full name or nil, and EMAIL is a valid email address."
"--"
("Filter Packages"
+ ["Filter by Archive" package-menu-filter-by-archive :help "Filter packages by archive"]
["Filter by Keyword" package-menu-filter-by-keyword :help "Filter packages by keyword"]
["Filter by Name" package-menu-filter-by-name :help "Filter packages by name"]
+ ["Filter by Status" package-menu-filter-by-status :help "Filter packages by status"]
+ ["Filter by Version" package-menu-filter-by-version :help "Filter packages by version"]
+ ["Filter Marked" package-menu-filter-marked :help "Filter packages marked for upgrade"]
["Clear Filter" package-menu-clear-filter :help "Clear package list filter"])
["Hide by Regexp" package-menu-hide-package :help "Hide all packages matching a regexp"]
@@ -2758,11 +2767,11 @@ Letters do not insert themselves; instead, they are commands.
(package-menu--transaction-status
package-menu--transaction-status)))
(setq tabulated-list-format
- `[("Package" 18 package-menu--name-predicate)
- ("Version" 13 package-menu--version-predicate)
- ("Status" 10 package-menu--status-predicate)
+ `[("Package" ,package-name-column-width package-menu--name-predicate)
+ ("Version" ,package-version-column-width package-menu--version-predicate)
+ ("Status" ,package-status-column-width package-menu--status-predicate)
,@(if (cdr package-archives)
- '(("Archive" 10 package-menu--archive-predicate)))
+ `(("Archive" ,package-archive-column-width package-menu--archive-predicate)))
("Description" 0 package-menu--description-predicate)])
(setq tabulated-list-padding 2)
(setq tabulated-list-sort-key (cons "Status" nil))
@@ -3041,8 +3050,21 @@ When none are given, the package matches."
found)
t))
-(defun package-menu--generate (remember-pos packages &optional keywords)
- "Populate the Package Menu.
+(defun package-menu--display (remember-pos suffix)
+ "Display the Package Menu.
+If REMEMBER-POS is non-nil, keep point on the same entry.
+
+If SUFFIX is non-nil, append that to \"Package\" for the first
+column in the header line."
+ (setf (car (aref tabulated-list-format 0))
+ (if suffix
+ (concat "Package[" suffix "]")
+ "Package"))
+ (tabulated-list-init-header)
+ (tabulated-list-print remember-pos))
+
+(defun package-menu--generate (remember-pos &optional packages keywords)
+ "Populate and display the Package Menu.
If REMEMBER-POS is non-nil, keep point on the same entry.
PACKAGES should be t, which means to display all known packages,
or a list of package names (symbols) to display.
@@ -3050,13 +3072,10 @@ or a list of package names (symbols) to display.
With KEYWORDS given, only packages with those keywords are
shown."
(package-menu--refresh packages keywords)
- (setf (car (aref tabulated-list-format 0))
- (if keywords
- (let ((filters (mapconcat #'identity keywords ",")))
- (concat "Package[" filters "]"))
- "Package"))
- (tabulated-list-init-header)
- (tabulated-list-print remember-pos))
+ (package-menu--display remember-pos
+ (when keywords
+ (let ((filters (mapconcat #'identity keywords ",")))
+ (concat "Package[" filters "]")))))
(defun package-menu--print-info (pkg)
"Return a package entry suitable for `tabulated-list-entries'.
@@ -3700,48 +3719,201 @@ shown."
(select-window win)
(switch-to-buffer buf))))
+(defun package-menu--filter-by (predicate suffix)
+ "Filter \"*Packages*\" buffer by PREDICATE and add SUFFIX to header.
+PREDICATE is a function which will be called with one argument, a
+`package-desc' object, and returns t if that object should be
+listed in the Package Menu.
+
+SUFFIX is passed on to `package-menu--display' and is added to
+the header line of the first column."
+ ;; Update `tabulated-list-entries' so that it contains all
+ ;; packages before searching.
+ (package-menu--refresh t nil)
+ (let (found-entries)
+ (dolist (entry tabulated-list-entries)
+ (when (funcall predicate (car entry))
+ (push entry found-entries)))
+ (if found-entries
+ (progn
+ (setq tabulated-list-entries found-entries)
+ (package-menu--display t suffix))
+ (user-error "No packages found"))))
+
+(defun package-menu-filter-by-archive (archive)
+ "Filter the \"*Packages*\" buffer by ARCHIVE.
+Display only packages from package archive ARCHIVE.
+
+When called interactively, prompt for ARCHIVE, which can be a
+comma-separated string. If ARCHIVE is empty, show all packages.
+
+When called from Lisp, ARCHIVE can be a string or a list of
+strings. If ARCHIVE is nil or the empty string, show all
+packages."
+ (interactive (list (completing-read-multiple
+ "Filter by archive (comma separated): "
+ (mapcar #'car package-archives))))
+ (package--ensure-package-menu-mode)
+ (let ((re (if (listp archive)
+ (regexp-opt archive)
+ archive)))
+ (package-menu--filter-by (lambda (pkg-desc)
+ (let ((pkg-archive (package-desc-archive pkg-desc)))
+ (and pkg-archive
+ (string-match-p re pkg-archive))))
+ (concat "archive:" (if (listp archive)
+ (string-join archive ",")
+ archive)))))
+
(defun package-menu-filter-by-keyword (keyword)
"Filter the \"*Packages*\" buffer by KEYWORD.
-Show only those items that relate to the specified KEYWORD.
-
-KEYWORD can be a string or a list of strings. If it is a list, a
-package will be displayed if it matches any of the keywords.
-Interactively, it is a list of strings separated by commas.
-
-KEYWORD can also be used to filter by status or archive name by
-using keywords like \"arc:gnu\" and \"status:available\".
-Statuses available include \"incompat\", \"available\",
-\"built-in\" and \"installed\"."
- (interactive
- (list (completing-read-multiple
- "Keywords (comma separated): " (package-all-keywords))))
+Display only packages with specified KEYWORD.
+
+When called interactively, prompt for KEYWORD, which can be a
+comma-separated string. If KEYWORD is empty, show all packages.
+
+When called from Lisp, KEYWORD can be a string or a list of
+strings. If KEYWORD is nil or the empty string, show all
+packages."
+ (interactive (list (completing-read-multiple
+ "Keywords (comma separated): "
+ (package-all-keywords))))
+ (when (stringp keyword)
+ (setq keyword (list keyword)))
(package--ensure-package-menu-mode)
- (package-show-package-list t (if (stringp keyword)
- (list keyword)
- keyword)))
+ (if (not keyword)
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (package--has-keyword-p pkg-desc keyword))
+ (concat "keyword:" (string-join keyword ",")))))
(define-obsolete-function-alias
'package-menu-filter #'package-menu-filter-by-keyword "27.1")
(defun package-menu-filter-by-name (name)
- "Filter the \"*Packages*\" buffer by NAME.
-Show only those items whose name matches the regular expression
-NAME. If NAME is nil or the empty string, show all packages."
- (interactive (list (read-from-minibuffer "Filter by name (regexp): ")))
+ "Filter the \"*Packages*\" buffer by NAME regexp.
+Display only packages with name that matches regexp NAME.
+
+When called interactively, prompt for NAME.
+
+If NAME is nil or the empty string, show all packages."
+ (interactive (list (read-regexp "Filter by name (regexp)")))
(package--ensure-package-menu-mode)
(if (or (not name) (string-empty-p name))
- (package-show-package-list t nil)
- ;; Update `tabulated-list-entries' so that it contains all
- ;; packages before searching.
- (package-menu--refresh t nil)
- (let (matched)
- (dolist (entry tabulated-list-entries)
- (let* ((pkg-name (package-desc-name (car entry))))
- (when (string-match name (symbol-name pkg-name))
- (push pkg-name matched))))
- (if matched
- (package-show-package-list matched nil)
- (user-error "No packages found")))))
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (string-match-p name (symbol-name
+ (package-desc-name pkg-desc))))
+ (format "name:%s" name))))
+
+(defun package-menu-filter-by-status (status)
+ "Filter the \"*Packages*\" buffer by STATUS.
+Display only packages with specified STATUS.
+
+When called interactively, prompt for STATUS, which can be a
+comma-separated string. If STATUS is empty, show all packages.
+
+When called from Lisp, STATUS can be a string or a list of
+strings. If STATUS is nil or the empty string, show all
+packages."
+ (interactive (list (completing-read "Filter by status: "
+ '("avail-obso"
+ "available"
+ "built-in"
+ "dependency"
+ "disabled"
+ "external"
+ "held"
+ "incompat"
+ "installed"
+ "new"
+ "unsigned"))))
+ (package--ensure-package-menu-mode)
+ (if (or (not status) (string-empty-p status))
+ (package-menu--generate t t)
+ (package-menu--filter-by (lambda (pkg-desc)
+ (string-match-p status (package-desc-status pkg-desc)))
+ (format "status:%s" status))))
+
+(defun package-menu-filter-by-version (version predicate)
+ "Filter the \"*Packages*\" buffer by VERSION and PREDICATE.
+Display only packages with a matching version.
+
+When called interactively, prompt for one of the qualifiers `<',
+`>' or `=', and a package version. Show only packages that has a
+lower (`<'), equal (`=') or higher (`>') version than the
+specified one.
+
+When called from Lisp, VERSION should be a version string and
+PREDICATE should be the symbol `=', `<' or `>'.
+
+If VERSION is nil or the empty string, show all packages."
+ (interactive (let ((choice (intern
+ (char-to-string
+ (read-char-choice
+ "Filter by version? [Type =, <, > or q] "
+ '(?< ?> ?= ?q))))))
+ (if (eq choice 'q)
+ '(quit nil)
+ (list (read-from-minibuffer
+ (concat "Filter by version ("
+ (pcase choice
+ ('= "= equal to")
+ ('< "< less than")
+ ('> "> greater than"))
+ "): "))
+ choice))))
+ (unless (equal predicate 'quit)
+ (if (or (not version) (string-empty-p version))
+ (package-menu--generate t t)
+ (package-menu--filter-by
+ (let ((fun (pcase predicate
+ ('= #'version-list-=)
+ ('< #'version-list-<)
+ ('> (lambda (a b) (not (version-list-<= a b))))
+ (_ (error "Unknown predicate: %s" predicate))))
+ (ver (version-to-list version)))
+ (lambda (pkg-desc)
+ (funcall fun (package-desc-version pkg-desc) ver)))
+ (format "versions:%s%s" predicate version)))))
+
+(defun package-menu-filter-marked ()
+ "Filter \"*Packages*\" buffer by non-empty upgrade mark.
+Unlike other filters, this leaves the marks intact."
+ (interactive)
+ (package--ensure-package-menu-mode)
+ (widen)
+ (let (found-entries mark pkg-id entry marks)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq mark (char-after))
+ (unless (eq mark ?\s)
+ (setq pkg-id (tabulated-list-get-id))
+ (setq entry (package-menu--print-info-simple pkg-id))
+ (push entry found-entries)
+ ;; remember the mark
+ (push (cons pkg-id mark) marks))
+ (forward-line))
+ (if found-entries
+ (progn
+ (setq tabulated-list-entries found-entries)
+ (package-menu--display t nil)
+ ;; redo the marks, but we must remember the marks!!
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq mark (cdr (assq (tabulated-list-get-id) marks)))
+ (tabulated-list-put-tag (char-to-string mark) t)))
+ (user-error "No packages found")))))
+
+(defun package-menu-filter-upgradable ()
+ "Filter \"*Packages*\" buffer to show only upgradable packages."
+ (interactive)
+ (let ((pkgs (mapcar #'car (package-menu--find-upgrades))))
+ (package-menu--filter-by
+ (lambda (pkg)
+ (memql (package-desc-name pkg) pkgs))
+ "upgradable")))
(defun package-menu-clear-filter ()
"Clear any filter currently applied to the \"*Packages*\" buffer."
@@ -3790,6 +3962,7 @@ The return value is a string (or nil in case we can't find it)."
(or (lm-header "package-version")
(lm-header "version")))))))))
+
;;;; Quickstart: precompute activation actions for faster start up.
;; Activating packages via `package-initialize' is costly: for N installed
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 36b93fa7ac5..e603900b095 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Keywords:
+;; Keywords: extensions
;; This file is part of GNU Emacs.
@@ -344,7 +344,8 @@ of the elements of LIST is performed as if by `pcase-let'.
(seen '())
(codegen
(lambda (code vars)
- (let ((prev (assq code seen)))
+ (let ((vars (pcase--fgrep vars code))
+ (prev (assq code seen)))
(if (not prev)
(let ((res (pcase-codegen code vars)))
(push (list code vars res) seen)
@@ -398,7 +399,10 @@ of the elements of LIST is performed as if by `pcase-let'.
(if (pcase--small-branch-p (cdr case))
;; Don't bother sharing multiple
;; occurrences of this leaf since it's small.
- #'pcase-codegen codegen)
+ (lambda (code vars)
+ (pcase-codegen code
+ (pcase--fgrep vars code)))
+ codegen)
(cdr case)
vars))))
cases))))
@@ -590,7 +594,7 @@ MATCH is the pattern that needs to be matched, of the form:
((null (cdr else-alts)) (car else-alts))
(t (cons (car match) (nreverse else-alts)))))))
((memq match '(:pcase--succeed :pcase--fail)) (cons match match))
- (t (error "Uknown MATCH %s" match))))
+ (t (error "Unknown MATCH %s" match))))
(defun pcase--split-rest (sym splitter rest)
(let ((then-rest '())
@@ -687,14 +691,22 @@ MATCH is the pattern that needs to be matched, of the form:
'(nil . :pcase--fail)
'(:pcase--fail . nil))))))
-(defun pcase--fgrep (vars sexp)
- "Check which of the symbols VARS appear in SEXP."
+(defun pcase--fgrep (bindings sexp)
+ "Return those of the BINDINGS which might be used in SEXP."
(let ((res '()))
- (while (consp sexp)
- (dolist (var (pcase--fgrep vars (pop sexp)))
- (unless (memq var res) (push var res))))
- (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
- res))
+ (while (and (consp sexp) bindings)
+ (dolist (binding (pcase--fgrep bindings (pop sexp)))
+ (push binding res)
+ (setq bindings (remove binding bindings))))
+ (if (vectorp sexp)
+ ;; With backquote, code can appear within vectors as well.
+ ;; This wouldn't be needed if we `macroexpand-all' before
+ ;; calling pcase--fgrep, OTOH.
+ (pcase--fgrep bindings (mapcar #'identity sexp))
+ (let ((tmp (assq sexp bindings)))
+ (if tmp
+ (cons tmp res)
+ res)))))
(defun pcase--self-quoting-p (upat)
(or (keywordp upat) (integerp upat) (stringp upat)))
@@ -713,7 +725,7 @@ MATCH is the pattern that needs to be matched, of the form:
(pcase--app-subst-match match sym fun nsym))
(cdr match))))
((memq match '(:pcase--succeed :pcase--fail)) match)
- (t (error "Uknown MATCH %s" match))))
+ (t (error "Unknown MATCH %s" match))))
(defun pcase--app-subst-rest (rest sym fun nsym)
(mapcar (lambda (branch)
@@ -734,13 +746,11 @@ MATCH is the pattern that needs to be matched, of the form:
"Build a function call to FUN with arg ARG."
(if (symbolp fun)
`(,fun ,arg)
- (let* (;; `vs' is an upper bound on the vars we need.
- (vs (pcase--fgrep (mapcar #'car vars) fun))
- (env (mapcar (lambda (var)
- (list var (cdr (assq var vars))))
- vs))
+ (let* (;; `env' is an upper bound on the bindings we need.
+ (env (mapcar (lambda (x) (list (car x) (cdr x)))
+ (pcase--fgrep vars fun)))
(call (progn
- (when (memq arg vs)
+ (when (assq arg env)
;; `arg' is shadowed by `env'.
(let ((newsym (gensym "x")))
(push (list newsym arg) env)
@@ -748,7 +758,7 @@ MATCH is the pattern that needs to be matched, of the form:
(if (functionp fun)
`(funcall #',fun ,arg)
`(,@fun ,arg)))))
- (if (null vs)
+ (if (null env)
call
;; Let's not replace `vars' in `fun' since it's
;; too difficult to do it right, instead just
@@ -759,10 +769,12 @@ MATCH is the pattern that needs to be matched, of the form:
"Build an expression that will evaluate EXP."
(let* ((found (assq exp vars)))
(if found (cdr found)
- (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
- (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
- vs)))
- (if env (macroexp-let* env exp) exp)))))
+ (let* ((env (pcase--fgrep vars exp)))
+ (if env
+ (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
+ env)
+ exp)
+ exp)))))
;; It's very tempting to use `pcase' below, tho obviously, it'd create
;; bootstrapping problems.
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index 3df7b0e368e..eb2ee94be3b 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -164,8 +164,11 @@ With argument, pretty-print output into current buffer.
Ignores leading comment characters."
(interactive "P")
(if arg
- (insert (pp-to-string (eval (pp-last-sexp) lexical-binding)))
- (pp-eval-expression (pp-last-sexp))))
+ (insert (pp-to-string (eval (elisp--eval-defun-1
+ (macroexpand (pp-last-sexp)))
+ lexical-binding)))
+ (pp-eval-expression (elisp--eval-defun-1
+ (macroexpand (pp-last-sexp))))))
;;;###autoload
(defun pp-macroexpand-last-sexp (arg)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 5e01895b9fc..78ae3a8c1e5 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -96,7 +96,7 @@
;; out.
;; Q: But how can I then make out the sub-expressions?
-;; A: Thats where the `sub-expression mode' comes in. In it only the
+;; A: That's where the `sub-expression mode' comes in. In it only the
;; digit keys are assigned to perform an update that will flash the
;; corresponding subexp only.
@@ -489,7 +489,7 @@ Optional argument SYNTAX must be specified if called non-interactively."
(interactive
(list (intern
(completing-read
- (format "Select syntax (default %s): " reb-re-syntax)
+ (format-prompt "Select syntax" reb-re-syntax)
'(read string sregex rx)
nil t nil nil (symbol-name reb-re-syntax)
'reb-change-syntax-hist))))
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
index 61af5e51bda..11b28b72cf3 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -4,7 +4,7 @@
;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
;; Created: 24-Feb-1993
-;; Version: 1.8
+;; Old-Version: 1.8
;; Last Modified: 1993/06/01 21:33:00
;; Keywords: extensions, matching
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 88c843f3ce6..76c3ac31b85 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1381,7 +1381,7 @@ To make local rx extensions, use `rx-let' for `rx',
For more details, see Info node `(elisp) Extending Rx'.
\(fn NAME [(ARGS...)] RX)"
- (declare (indent 1))
+ (declare (indent defun))
`(eval-and-compile
(put ',name 'rx-definition ',(rx--make-binding name definition))
',name))
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 42b145da2fd..4656277ea16 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -4,7 +4,7 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: sequences
-;; Version: 2.21
+;; Version: 2.22
;; Package: seq
;; Maintainer: emacs-devel@gnu.org
@@ -350,6 +350,7 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called."
(setq acc (funcall function acc elt)))
acc)))
+;;;###autoload
(cl-defgeneric seq-every-p (pred sequence)
"Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE."
(catch 'seq--break
@@ -473,6 +474,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
(seq-reverse sequence1)
'()))
+;;;###autoload
(cl-defgeneric seq-group-by (function sequence)
"Apply FUNCTION to each element of SEQUENCE.
Separate the elements of SEQUENCE into an alist using the results as
@@ -493,6 +495,7 @@ keys. Keys are compared using `equal'."
SEQUENCE must be a sequence of numbers or markers."
(apply #'min (seq-into sequence 'list)))
+;;;###autoload
(cl-defgeneric seq-max (sequence)
"Return the largest element of SEQUENCE.
SEQUENCE must be a sequence of numbers or markers."
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index 4ff129e367a..dd614dd792c 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -55,9 +55,6 @@
:prefix "load-path-shadows-"
:group 'lisp)
-(define-obsolete-variable-alias 'shadows-compare-text-p
- 'load-path-shadows-compare-text "23.3")
-
(defcustom load-path-shadows-compare-text nil
"If non-nil, then shadowing files are reported only if their text differs.
This is slower, but filters out some innocuous shadowing."
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
new file mode 100644
index 00000000000..37d6170fee5
--- /dev/null
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -0,0 +1,1254 @@
+;;; shortdoc.el --- Short function summaries -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Keywords: lisp, help
+;; Package: emacs
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'seq)
+(require 'text-property-search)
+(eval-when-compile (require 'cl-lib))
+
+(defgroup shortdoc nil
+ "Short documentation."
+ :group 'lisp)
+
+(defface shortdoc-separator
+ '((((class color) (background dark))
+ :height 0.1 :background "#505050" :extend t)
+ (((class color) (background light))
+ :height 0.1 :background "#a0a0a0" :extend t)
+ (t :height 0.1 :inverse-video t :extend t))
+ "Face used to separate sections.")
+
+(defface shortdoc-section
+ '((t :inherit variable-pitch))
+ "Face used for a section.")
+
+(defvar shortdoc--groups nil)
+
+(defmacro define-short-documentation-group (group &rest functions)
+ "Add GROUP to the list of defined documentation groups.
+FUNCTIONS is a list of elements on the form:
+
+ (fun
+ :no-manual BOOL
+ :args ARGS
+ :eval EXAMPLE-FORM
+ :no-eval EXAMPLE-FORM
+ :no-value EXAMPLE-FORM
+ :result RESULT-FORM
+ :eg-result RESULT-FORM
+ :eg-result-string RESULT-FORM)
+
+BOOL should be non-nil if the function isn't documented in the
+manual.
+
+ARGS is optional; the function's signature is displayed if ARGS
+is not present.
+
+If EVAL isn't a string, it will be printed with `prin1', and then
+evaluated to give a result, which is also printed. If it's a
+string, it'll be inserted as is, then the string will be `read',
+and then evaluated.
+
+There can be any number of :example/:result elements."
+ `(progn
+ (setq shortdoc--groups (delq (assq ',group shortdoc--groups)
+ shortdoc--groups))
+ (push (cons ',group ',functions) shortdoc--groups)))
+
+(define-short-documentation-group alist
+ "Alist Basics"
+ (assoc
+ :eval (assoc 'foo '((foo . bar) (zot . baz))))
+ (rassoc
+ :eval (rassoc 'bar '((foo . bar) (zot . baz))))
+ (assq
+ :eval (assq 'foo '((foo . bar) (zot . baz))))
+ (rassq
+ :eval (rassq 'bar '((foo . bar) (zot . baz))))
+ (assoc-string
+ :eval (assoc-string "foo" '(("foo" . "bar") ("zot" "baz"))))
+ "Manipulating Alists"
+ (assoc-delete-all
+ :eval (assoc-delete-all "foo" '(("foo" . "bar") ("zot" . "baz")) #'equal))
+ (assq-delete-all
+ :eval (assq-delete-all 'foo '((foo . bar) (zot . baz))))
+ (rassq-delete-all
+ :eval (rassq-delete-all 'bar '((foo . bar) (zot . baz))))
+ (alist-get
+ :eval (let ((foo '((bar . baz))))
+ (setf (alist-get 'bar foo) 'zot)
+ foo))
+ "Misc"
+ (assoc-default
+ :eval (assoc-default "foobar" '(("foo" . baz)) #'string-match))
+ (copy-alist
+ :eval (let* ((old '((foo . bar)))
+ (new (copy-alist old)))
+ (eq old new)))
+ ;; FIXME: Outputs "\.rose" for the symbol `.rose'.
+ ;; (let-alist
+ ;; :eval (let ((colors '((rose . red)
+ ;; (lily . white))))
+ ;; (let-alist colors
+ ;; (if (eq .rose 'red)
+ ;; .lily))))
+ )
+
+(define-short-documentation-group string
+ "Making Strings"
+ (make-string
+ :args (length init)
+ :eval "(make-string 5 ?x)")
+ (string
+ :eval "(string ?a ?b ?c)")
+ (concat
+ :eval (concat "foo" "bar" "zot"))
+ (string-join
+ :no-manual t
+ :eval (string-join '("foo" "bar" "zot") " "))
+ (mapconcat
+ :eval (mapconcat (lambda (a) (concat "[" a "]"))
+ '("foo" "bar" "zot") " "))
+ (mapcar
+ :eval (mapcar #'identity "123"))
+ (format
+ :eval (format "This number is %d" 4))
+ "Manipulating Strings"
+ (substring
+ :eval (substring "foobar" 0 3)
+ :eval (substring "foobar" 3))
+ (split-string
+ :eval (split-string "foo bar")
+ :eval (split-string "|foo|bar|" "|")
+ :eval (split-string "|foo|bar|" "|" t))
+ (string-replace
+ :eval (string-replace "foo" "bar" "foozot"))
+ (replace-regexp-in-string
+ :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*"))
+ (string-trim
+ :no-manual t
+ :args (string)
+ :doc "Trim STRING of leading and trailing white space."
+ :eval (string-trim " foo "))
+ (string-trim-left
+ :no-manual t
+ :eval (string-trim-left "oofoo" "o+"))
+ (string-trim-right
+ :no-manual t
+ :eval (string-trim-right "barkss" "s+"))
+ (string-truncate-left
+ :no-manual t
+ :eval (string-truncate-left "longstring" 8))
+ (string-remove-suffix
+ :no-manual t
+ :eval (string-remove-suffix "bar" "foobar"))
+ (string-remove-prefix
+ :no-manual t
+ :eval (string-remove-prefix "foo" "foobar"))
+ (reverse
+ :eval (reverse "foo"))
+ (substring-no-properties
+ :eval (substring-no-properties (propertize "foobar" 'face 'bold) 0 3))
+ "Predicates for Strings"
+ (string-equal
+ :eval (string-equal "foo" "foo"))
+ (eq
+ :eval (eq "foo" "foo"))
+ (eql
+ :eval (eql "foo" "foo"))
+ (equal
+ :eval (equal "foo" "foo"))
+ (cl-equalp
+ :eval (cl-equalp "Foo" "foo"))
+ (stringp
+ :eval "(stringp ?a)")
+ (string-empty-p
+ :no-manual t
+ :eval (string-empty-p ""))
+ (string-blank-p
+ :no-manual t
+ :eval (string-blank-p " \n"))
+ (string-lessp
+ :eval (string-lessp "foo" "bar"))
+ (string-greaterp
+ :eval (string-greaterp "foo" "bar"))
+ (string-version-lessp
+ :eval (string-lessp "foo32.png" "bar4.png"))
+ (string-prefix-p
+ :eval (string-prefix-p "foo" "foobar"))
+ (string-suffix-p
+ :eval (string-suffix-p "bar" "foobar"))
+ "Case Manipulation"
+ (upcase
+ :eval (upcase "foo"))
+ (downcase
+ :eval (downcase "FOObar"))
+ (capitalize
+ :eval (capitalize "foo bar zot"))
+ (upcase-initials
+ :eval (upcase-initials "The CAT in the hAt"))
+ "Converting Strings"
+ (string-to-number
+ :eval (string-to-number "42")
+ :eval (string-to-number "deadbeef" 16))
+ (number-to-string
+ :eval (number-to-string 42))
+ "Data About Strings"
+ (length
+ :eval (length "foo"))
+ (string-search
+ :eval (string-search "bar" "foobarzot"))
+ (assoc-string
+ :eval (assoc-string "foo" '(("a" 1) (foo 2))))
+ (seq-position
+ :eval "(seq-position \"foobarzot\" ?z)"))
+
+(define-short-documentation-group file-name
+ "File Name Manipulation"
+ (file-name-directory
+ :eval (file-name-directory "/tmp/foo")
+ :eval (file-name-directory "/tmp/foo/"))
+ (file-name-nondirectory
+ :eval (file-name-nondirectory "/tmp/foo")
+ :eval (file-name-nondirectory "/tmp/foo/"))
+ (file-name-sans-versions
+ :args (filename)
+ :eval (file-name-sans-versions "/tmp/foo~"))
+ (file-name-extension
+ :eval (file-name-extension "/tmp/foo.txt"))
+ (file-name-sans-extension
+ :eval (file-name-sans-extension "/tmp/foo.txt"))
+ (file-name-base
+ :eval (file-name-base "/tmp/foo.txt"))
+ (file-relative-name
+ :eval (file-relative-name "/tmp/foo" "/tmp"))
+ (make-temp-name
+ :eval (make-temp-name "/tmp/foo-"))
+ (expand-file-name
+ :eval (expand-file-name "foo" "/tmp/"))
+ (substitute-in-file-name
+ :eval (substitute-in-file-name "$HOME/foo"))
+ "Directory Functions"
+ (file-name-as-directory
+ :eval (file-name-as-directory "/tmp/foo"))
+ (directory-file-name
+ :eval (directory-file-name "/tmp/foo/"))
+ (abbreviate-file-name
+ :no-eval (abbreviate-file-name "/home/some-user")
+ :eg-result "~some-user")
+ "Quoted File Names"
+ (file-name-quote
+ :args (name)
+ :eval (file-name-quote "/tmp/foo"))
+ (file-name-unquote
+ :args (name)
+ :eval (file-name-unquote "/:/tmp/foo"))
+ "Predicates"
+ (file-name-absolute-p
+ :eval (file-name-absolute-p "/tmp/foo")
+ :eval (file-name-absolute-p "foo"))
+ (directory-name-p
+ :eval (directory-name-p "/tmp/foo/"))
+ (file-name-quoted-p
+ :eval (file-name-quoted-p "/:/tmp/foo")))
+
+(define-short-documentation-group file
+ "Inserting Contents"
+ (insert-file-contents
+ :no-eval (insert-file-contents "/tmp/foo")
+ :eg-result ("/tmp/foo" 6))
+ (insert-file-contents-literally
+ :no-eval (insert-file-contents-literally "/tmp/foo")
+ :eg-result ("/tmp/foo" 6))
+ (find-file
+ :no-eval (find-file "/tmp/foo")
+ :eg-result-string "#<buffer foo>")
+ "Predicates"
+ (file-symlink-p
+ :no-eval (file-symlink-p "/tmp/foo")
+ :eg-result t)
+ (file-directory-p
+ :no-eval (file-directory-p "/tmp")
+ :eg-result t)
+ (file-regular-p
+ :no-eval (file-regular-p "/tmp/foo")
+ :eg-result t)
+ (file-exists-p
+ :no-eval (file-exists-p "/tmp/foo")
+ :eg-result t)
+ (file-readable-p
+ :no-eval (file-readable-p "/tmp/foo")
+ :eg-result t)
+ (file-writeable-p
+ :no-eval (file-writeable-p "/tmp/foo")
+ :eg-result t)
+ (file-accessible-directory-p
+ :no-eval (file-accessible-directory-p "/tmp")
+ :eg-result t)
+ (file-executable-p
+ :no-eval (file-executable-p "/bin/cat")
+ :eg-result t)
+ (file-newer-than-file-p
+ :no-eval (file-newer-than-file-p "/tmp/foo" "/tmp/bar")
+ :eg-result nil)
+ (file-equal-p
+ :no-eval (file-equal-p "/tmp/foo" "/tmp/bar")
+ :eg-result nil)
+ (file-in-directory-p
+ :no-eval (file-in-directory-p "/tmp/foo" "/tmp/")
+ :eg-result t)
+ (file-locked-p
+ :no-eval (file-locked-p "/tmp/foo")
+ :eg-result nil)
+ "Information"
+ (file-attributes
+ :no-eval* (file-attributes "/tmp"))
+ (file-truename
+ :no-eval (file-truename "/tmp/foo/bar")
+ :eg-result "/tmp/foo/zot")
+ (file-chase-links
+ :no-eval (file-chase-links "/tmp/foo/bar")
+ :eg-result "/tmp/foo/zot")
+ (vc-responsible-backend
+ :args (file &optional no-error)
+ :no-eval (vc-responsible-backend "/src/foo/bar.c")
+ :eg-result Git)
+ (file-acl
+ :no-eval (file-acl "/tmp/foo")
+ :eg-result "user::rw-\ngroup::r--\nother::r--\n")
+ (file-extended-attributes
+ :no-eval* (file-extended-attributes "/tmp/foo"))
+ (file-selinux-context
+ :no-eval* (file-selinux-context "/tmp/foo"))
+ (locate-file
+ :no-eval (locate-file "syslog" '("/var/log" "/usr/bin"))
+ :eg-result "/var/log/syslog")
+ (executable-find
+ :no-eval (executable-find "ls")
+ :eg-result "/usr/bin/ls")
+ "Creating"
+ (make-temp-file
+ :no-eval (make-temp-file "/tmp/foo-")
+ :eg-result "/tmp/foo-ZcXFMj")
+ (make-nearby-temp-file
+ :no-eval (make-nearby-temp-file "/tmp/foo-")
+ :eg-result "/tmp/foo-xe8iON")
+ (write-region
+ :no-value (write-region (point-min) (point-max) "/tmp/foo"))
+ "Directories"
+ (make-directory
+ :no-value (make-directory "/tmp/bar/zot/" t))
+ (directory-files
+ :no-eval (directory-files "/tmp/")
+ :eg-result ("." ".." ".ICE-unix" ".Test-unix"))
+ (directory-files-recursively
+ :no-eval (directory-files-recursively "/tmp/" "\\.png\\'")
+ :eg-result ("/tmp/foo.png" "/tmp/zot.png" "/tmp/bar/foobar.png"))
+ (directory-files-and-attributes
+ :no-eval* (directory-files-and-attributes "/tmp/foo"))
+ (file-expand-wildcards
+ :no-eval (file-expand-wildcards "/tmp/*.png")
+ :eg-result ("/tmp/foo.png" "/tmp/zot.png"))
+ (locate-dominating-file
+ :no-eval (locate-dominating-file "foo.png" "/tmp/foo/bar/zot")
+ :eg-result "/tmp/foo.png")
+ (copy-directory
+ :no-value (copy-directory "/tmp/bar/" "/tmp/barcopy"))
+ (delete-directory
+ :no-value (delete-directory "/tmp/bar/"))
+ "File Operations"
+ (rename-file
+ :no-value (rename-file "/tmp/foo" "/tmp/newname"))
+ (copy-file
+ :no-value (copy-file "/tmp/foo" "/tmp/foocopy"))
+ (delete-file
+ :no-value (delete-file "/tmp/foo"))
+ (make-empty-file
+ :no-value (make-empty-file "/tmp/foo"))
+ (make-symbolic-link
+ :no-value (make-symbolic-link "/tmp/foo" "/tmp/foosymlink"))
+ (add-name-to-file
+ :no-value (add-name-to-file "/tmp/foo" "/tmp/bar"))
+ (set-file-modes
+ :no-value "(set-file-modes \"/tmp/foo\" #o644)")
+ (set-file-times
+ :no-value (set-file-times "/tmp/foo" (current-time)))
+ "File Modes"
+ (set-default-file-modes
+ :no-value "(set-default-file-modes #o755)")
+ (default-file-modes
+ :no-eval (default-file-modes)
+ :eg-result-string "#o755")
+ (file-modes-symbolic-to-number
+ :no-eval (file-modes-symbolic-to-number "a+r")
+ :eg-result-string "#o444")
+ (file-modes-number-to-symbolic
+ :eval "(file-modes-number-to-symbolic #o444)")
+ (set-file-extended-attributes
+ :no-eval (set-file-extended-attributes
+ "/tmp/foo" '((acl . "group::rxx")))
+ :eg-result t)
+ (set-file-selinux-context
+ :no-eval (set-file-selinux-context
+ "/tmp/foo" '(unconfined_u object_r user_home_t s0))
+ :eg-result t)
+ (set-file-acl
+ :no-eval (set-file-acl "/tmp/foo" "group::rxx")
+ :eg-result t))
+
+(define-short-documentation-group hash-table
+ "Hash Table Basics"
+ (make-hash-table
+ :no-eval (make-hash-table)
+ :result-string "#s(hash-table ...)")
+ (puthash
+ :no-eval (puthash 'key "value" table))
+ (gethash
+ :no-eval (gethash 'key table)
+ :eg-result "value")
+ (remhash
+ :no-eval (remhash 'key table)
+ :result nil)
+ (clrhash
+ :no-eval (clrhash table)
+ :result-string "#s(hash-table ...)")
+ (maphash
+ :no-eval (maphash (lambda (key value) (message value)) table)
+ :result nil)
+ "Other Hash Table Functions"
+ (hash-table-p
+ :eval (hash-table-p 123))
+ (copy-hash-table
+ :no-eval (copy-hash-table table)
+ :result-string "#s(hash-table ...)")
+ (hash-table-count
+ :no-eval (hash-table-count table)
+ :eg-result 15)
+ (hash-table-size
+ :no-eval (hash-table-size table)
+ :eg-result 65))
+
+(define-short-documentation-group list
+ "Making Lists"
+ (make-list
+ :eval (make-list 5 'a))
+ (cons
+ :eval (cons 1 '(2 3 4)))
+ (list
+ :eval (list 1 2 3))
+ (number-sequence
+ :eval (number-sequence 5 8))
+ "Operations on Lists"
+ (append
+ :eval (append '("foo" "bar") '("zot")))
+ (copy-tree
+ :eval (copy-tree '(1 (2 3) 4)))
+ (flatten-tree
+ :eval (flatten-tree '(1 (2 3) 4)))
+ (car
+ :eval (car '(one two three)))
+ (cdr
+ :eval (cdr '(one two three)))
+ (last
+ :eval (last '(one two three)))
+ (butlast
+ :eval (butlast '(one two three)))
+ (nbutlast
+ :eval (nbutlast (list 'one 'two 'three)))
+ (nth
+ :eval (nth 1 '(one two three)))
+ (nthcdr
+ :eval (nthcdr 1 '(one two three)))
+ (elt
+ :eval (elt '(one two three) 1))
+ (car-safe
+ :eval (car-safe '(one two three)))
+ (cdr-safe
+ :eval (cdr-safe '(one two three)))
+ (push
+ :no-eval* (push 'a list))
+ (pop
+ :no-eval* (pop list))
+ (setcar
+ :no-eval (setcar list 'c)
+ :result c)
+ (setcdr
+ :no-eval (setcdr list (list c))
+ :result '(c))
+ (nconc
+ :eval (nconc (list 1) (list 2 3 4)))
+ (delq
+ :eval (delq 2 (list 1 2 3 4))
+ :eval (delq "a" (list "a" "b" "c" "d")))
+ (delete
+ :eval (delete 2 (list 1 2 3 4))
+ :eval (delete "a" (list "a" "b" "c" "d")))
+ (remove
+ :eval (remove 2 '(1 2 3 4))
+ :eval (remove "a" '("a" "b" "c" "d")))
+ (delete-dups
+ :eval (delete-dups (list 1 2 4 3 2 4)))
+ "Mapping Over Lists"
+ (mapcar
+ :eval (mapcar #'list '(1 2 3)))
+ (mapcan
+ :eval (mapcan #'list '(1 2 3)))
+ (mapc
+ :eval (mapc #'insert '("1" "2" "3")))
+ (reduce
+ :eval (reduce #'+ '(1 2 3)))
+ (mapconcat
+ :eval (mapconcat #'identity '("foo" "bar") "|"))
+ "Predicates"
+ (listp
+ :eval (listp '(1 2 3))
+ :eval (listp nil)
+ :eval (listp '(1 . 2)))
+ (consp
+ :eval (consp '(1 2 3))
+ :eval (consp nil))
+ (proper-list-p
+ :eval (proper-list-p '(1 2 3))
+ :eval (proper-list-p nil)
+ :eval (proper-list-p '(1 . 2)))
+ (null
+ :eval (null nil))
+ (atom
+ :eval (atom 'a))
+ (nlistp
+ :eval (nlistp '(1 2 3))
+ :eval (nlistp t)
+ :eval (nlistp '(1 . 2)))
+ "Finding Elements"
+ (memq
+ :eval (memq 2 '(1 2 3))
+ :eval (memq 2.0 '(1.0 2.0 3.0))
+ :eval (memq "b" '("a" "b" "c")))
+ (member
+ :eval (member 2 '(1 2 3))
+ :eval (member "b" '("a" "b" "c")))
+ (remq
+ :eval (remq 2 '(1 2 3 2 4 2))
+ :eval (remq "b" '("a" "b" "c")))
+ (memql
+ :eval (memql 2.0 '(1.0 2.0 3.0)))
+ (member-ignore-case
+ :eval (member-ignore-case "foo" '("bar" "Foo" "zot")))
+ "Association Lists"
+ (assoc
+ :eval (assoc 'b '((a 1) (b 2))))
+ (rassoc
+ :eval (rassoc '2 '((a . 1) (b . 2))))
+ (assq
+ :eval (assq 'b '((a 1) (b 2)))
+ :eval (assq "a" '(("a" 1) ("b" 2))))
+ (rassq
+ :eval (rassq '2 '((a . 1) (b . 2))))
+ (assoc-string
+ :eval (assoc-string "foo" '(("a" 1) (foo 2))))
+ (alist-get
+ :eval (alist-get 2 '((1 . a) (2 . b))))
+ (assoc-default
+ :eval (assoc-default 2 '((1 . a) (2 . b) #'=)))
+ (copy-alist
+ :eval (copy-alist '((1 . a) (2 . b))))
+ (assq-delete-all
+ :eval (assq-delete-all 2 (list '(1 . a) '(2 . b) '(2 . c))))
+ (assoc-delete-all
+ :eval (assoc-delete-all "b" (list '("a" . a) '("b" . b) '("b" . c))))
+ "Property Lists"
+ (plist-get
+ :eval (plist-get '(a 1 b 2 c 3) 'b))
+ (plist-put
+ :no-eval (setq plist (plist-put plist 'd 4))
+ :eq-result (a 1 b 2 c 3 d 4))
+ (lax-plist-get
+ :eval (lax-plist-get '("a" 1 "b" 2 "c" 3) "b"))
+ (lax-plist-put
+ :no-eval (setq plist (plist-put plist "d" 4))
+ :eq-result '("a" 1 "b" 2 "c" 3 "d" 4))
+ (plist-member
+ :eval (plist-member '(a 1 b 2 c 3) 'b))
+ "Data About Lists"
+ (length
+ :eval (length '(a b c)))
+ (safe-length
+ :eval (safe-length '(a b c))))
+
+
+(define-short-documentation-group vector
+ (make-vector
+ :eval (make-vector 5 "foo"))
+ (vector
+ :eval (vector 1 "b" 3))
+ (vectorp
+ :eval (vectorp [1])
+ :eval (vectorp "1"))
+ (vconcat
+ :eval (vconcat '(1 2) [3 4]))
+ (append
+ :eval (append [1 2] nil))
+ (length
+ :eval (length [1 2 3]))
+ (mapcar
+ :eval (mapcar #'identity [1 2 3]))
+ (reduce
+ :eval (reduce #'+ [1 2 3]))
+ (seq-subseq
+ :eval (seq-subseq [1 2 3 4 5] 1 3)
+ :eval (seq-subseq [1 2 3 4 5] 1)))
+
+(define-short-documentation-group regexp
+ "Matching Strings"
+ (replace-regexp-in-string
+ :eval (replace-regexp-in-string "[a-z]+" "_" "*foo*"))
+ (string-match-p
+ :eval (string-match-p "^[fo]+" "foobar"))
+ "Looking in Buffers"
+ (re-search-forward
+ :no-eval (re-search-forward "^foo$" nil t)
+ :eg-result 43)
+ (re-search-backward
+ :no-eval (re-search-backward "^foo$" nil t)
+ :eg-result 43)
+ (looking-at-p
+ :no-eval (looking-at "f[0-9]")
+ :eg-result t)
+ "Match Data"
+ (match-string
+ :eval (and (string-match "^\\([fo]+\\)b" "foobar")
+ (match-string 0 "foobar")))
+ (match-beginning
+ :no-eval (match-beginning 1)
+ :eg-result 0)
+ (match-end
+ :no-eval (match-end 1)
+ :eg-result 3)
+ (save-match-data
+ :no-eval (save-match-data ...))
+ "Replacing Match"
+ (replace-match
+ :no-eval (replace-match "new")
+ :eg-result nil)
+ (match-substitute-replacement
+ :no-eval (match-substitute-replacement "new")
+ :eg-result "new")
+ "Utilities"
+ (regexp-quote
+ :eval (regexp-quote "foo.*bar"))
+ (regexp-opt
+ :eval (regexp-opt '("foo" "bar")))
+ (regexp-opt-depth
+ :eval (regexp-opt-depth "\\(a\\(b\\)\\)"))
+ (regexp-opt-charset
+ :eval (regexp-opt-charset '(?a ?b ?c ?d ?e)))
+ "The `rx' Structured Regexp Notation"
+ (rx
+ :eval (rx "IP=" (+ digit) (= 3 "." (+ digit))))
+ (rx-to-string
+ :eval (rx-to-string '(| "foo" "bar")))
+ (rx-define
+ :no-eval "(and (rx-define haskell-comment (seq \"--\" (zero-or-more nonl)))
+ (rx haskell-comment))"
+ :result "--.*")
+ (rx-let
+ :eval "(rx-let ((comma-separated (item) (seq item (0+ \",\" item)))
+ (number (1+ digit))
+ (numbers (comma-separated number)))
+ (rx \"(\" numbers \")\"))"
+ :result "([[:digit:]]+\\(?:,[[:digit:]]+\\)*)")
+ (rx-let-eval
+ :eval "(rx-let-eval
+ '((ponder (x) (seq \"Where have all the \" x \" gone?\")))
+ (rx-to-string
+ '(ponder (or \"flowers\" \"cars\" \"socks\"))))"
+ :result "\\(?:Where have all the \\(?:\\(?:car\\|flower\\|sock\\)s\\) gone\\?\\)"))
+
+(define-short-documentation-group sequence
+ "Sequence Predicates"
+ (seq-contains-p
+ :eval (seq-contains-p '(a b c) 'b)
+ :eval (seq-contains-p '(a b c) 'd))
+ (seq-every-p
+ :eval (seq-every-p #'numberp '(1 2 3)))
+ (seq-empty-p
+ :eval (seq-empty-p []))
+ (seq-set-equal-p
+ :eval (seq-set-equal-p '(1 2 3) '(3 1 2)))
+ (seq-some
+ :eval (seq-some #'cl-evenp '(1 2 3)))
+ "Building Sequences"
+ (seq-concatenate
+ :eval (seq-concatenate 'vector '(1 2) '(c d)))
+ (seq-copy
+ :eval (seq-copy '(a 2)))
+ (seq-into
+ :eval (seq-into '(1 2 3) 'vector))
+ "Utility Functions"
+ (seq-count
+ :eval (seq-count #'numberp '(1 b c 4)))
+ (seq-elt
+ :eval (seq-elt '(a b c) 1))
+ (seq-random-elt
+ :no-eval (seq-random-elt '(a b c))
+ :eg-result c)
+ (seq-find
+ :eval (seq-find #'numberp '(a b 3 4 f 6)))
+ (seq-position
+ :eval (seq-position '(a b c) 'c))
+ (seq-length
+ :eval (seq-length "abcde"))
+ (seq-max
+ :eval (seq-max [1 2 3]))
+ (seq-min
+ :eval (seq-min [1 2 3]))
+ (seq-first
+ :eval (seq-first [a b c]))
+ (seq-rest
+ :eval (seq-rest '[1 2 3]))
+ (seq-reverse
+ :eval (seq-reverse '(1 2 3)))
+ (seq-sort
+ :eval (seq-sort #'> '(1 2 3)))
+ (seq-sort-by
+ :eval (seq-sort-by (lambda (a) (/ 1.0 a)) #'< '(1 2 3)))
+ "Mapping Over Sequences"
+ (seq-map
+ :eval (seq-map #'1+ '(1 2 3)))
+ (seq-map-indexed
+ :eval (seq-map-indexed (lambda (a i) (cons i a)) '(a b c)))
+ (seq-mapcat
+ :eval (seq-mapcat #'upcase '("a" "b" "c") 'string))
+ (seq-do
+ :no-eval (seq-do (lambda (a) (insert a)) '("foo" "bar"))
+ :eg-result ("foo" "bar"))
+ (seq-do-indexed
+ :no-eval (seq-do-indexed
+ (lambda (a index) (message "%s:%s" index a))
+ '("foo" "bar"))
+ :eg-result nil)
+ (seq-reduce
+ :eval (seq-reduce #'* [1 2 3] 2))
+ "Excerpting Sequences"
+ (seq-drop
+ :eval (seq-drop '(a b c) 2))
+ (seq-drop-while
+ :eval (seq-drop-while #'numberp '(1 2 c d 5)))
+ (seq-filter
+ :eval (seq-filter #'numberp '(a b 3 4 f 6)))
+ (seq-remove
+ :eval (seq-remove #'numberp '(1 2 c d 5)))
+ (seq-group-by
+ :eval (seq-group-by #'cl-plusp '(-1 2 3 -4 -5 6)))
+ (seq-difference
+ :eval (seq-difference '(1 2 3) '(2 3 4)))
+ (seq-intersection
+ :eval (seq-intersection '(1 2 3) '(2 3 4)))
+ (seq-partition
+ :eval (seq-partition '(a b c d e f g h) 3))
+ (seq-subseq
+ :eval (seq-subseq '(a b c d e) 2 4))
+ (seq-take
+ :eval (seq-take '(a b c d e) 3))
+ (seq-take-while
+ :eval (seq-take-while #'cl-evenp [2 4 9 6 5]))
+ (seq-uniq
+ :eval (seq-uniq '(a b d b a c))))
+
+(define-short-documentation-group buffer
+ "Buffer Basics"
+ (current-buffer
+ :no-eval (current-buffer)
+ :eg-result-string "#<buffer shortdoc.el>")
+ (bufferp
+ :eval (bufferp 23))
+ (buffer-live-p
+ :no-eval (buffer-live-p some-buffer)
+ :eg-result t)
+ (buffer-modified-p
+ :eval (buffer-modified-p (current-buffer)))
+ (buffer-name
+ :eval (buffer-name))
+ (window-buffer
+ :eval (window-buffer))
+ "Selecting Buffers"
+ (get-buffer-create
+ :no-eval (get-buffer-create "*foo*")
+ :eg-result-string "#<buffer *foo*>")
+ (pop-to-buffer
+ :no-eval (pop-to-buffer "*foo*")
+ :eg-result-string "#<buffer *foo*>")
+ (with-current-buffer
+ :no-eval* (with-current-buffer buffer (buffer-size)))
+ "Points and Positions"
+ (point
+ :eval (point))
+ (point-min
+ :eval (point-max))
+ (point-max
+ :eval (point-max))
+ (line-beginning-position
+ :eval (line-beginning-position))
+ (line-end-position
+ :eval (line-end-position))
+ (buffer-size
+ :eval (buffer-size))
+ "Moving Around"
+ (goto-char
+ :no-eval (goto-char (point-max))
+ :eg-result 342)
+ (search-forward
+ :no-eval (search-forward "some-string" nil t)
+ :eg-result 245)
+ (re-search-forward
+ :no-eval (re-search-forward "some-s.*g" nil t)
+ :eg-result 245)
+ (forward-line
+ :no-eval (forward-line 1)
+ :eg-result 0
+ :no-eval (forward-line -2)
+ :eg-result 0)
+ "Strings from Buffers"
+ (buffer-string
+ :no-eval* (buffer-string))
+ (buffer-substring
+ :eval (buffer-substring (point-min) (+ (point-min) 10)))
+ (buffer-substring-no-properties
+ :eval (buffer-substring-no-properties (point-min) (+ (point-min) 10)))
+ (following-char
+ :no-eval (following-char)
+ :eg-result 67)
+ (char-after
+ :eval (char-after 45))
+ "Altering Buffers"
+ (delete-region
+ :no-value (delete-region (point-min) (point-max)))
+ (erase-buffer
+ :no-value (erase-buffer))
+ (insert
+ :no-value (insert "This string will be inserted in the buffer\n"))
+ "Locking"
+ (lock-buffer
+ :no-value (lock-buffer "/tmp/foo"))
+ (unlock-buffer
+ :no-value (lock-buffer)))
+
+(define-short-documentation-group process
+ (make-process
+ :no-eval (make-process :name "foo" :command '("cat" "/tmp/foo"))
+ :eg-result-string "#<process foo>")
+ (processp
+ :eval (processp t))
+ (delete-process
+ :no-value (delete-process process))
+ (kill-process
+ :no-value (kill-process process))
+ (set-process-sentinel
+ :no-value (set-process-sentinel process (lambda (proc string))))
+ (process-buffer
+ :no-eval (process-buffer process)
+ :eg-result-string "#<buffer *foo*>")
+ (get-buffer-process
+ :no-eval (get-buffer-process buffer)
+ :eg-result-string "#<process foo>")
+ (process-live-p
+ :no-eval (process-live-p process)
+ :eg-result t))
+
+(define-short-documentation-group number
+ "Arithmetic"
+ (+
+ :args (&rest numbers)
+ :eval (+ 1 2)
+ :eval (+ 1 2 3 4))
+ (-
+ :args (&rest numbers)
+ :eval (- 3 2)
+ :eval (- 6 3 2))
+ (*
+ :args (&rest numbers)
+ :eval (* 3 4 5))
+ (/
+ :eval (/ 10 5)
+ :eval (/ 10 6)
+ :eval (/ 10.0 6)
+ :eval (/ 10.0 3 3))
+ (%
+ :eval (% 10 5)
+ :eval (% 10 6))
+ (mod
+ :eval (mod 10 5)
+ :eval (mod 10 6)
+ :eval (mod 10.5 6))
+ (1+
+ :eval (1+ 2))
+ (1-
+ :eval (1- 4))
+ "Predicates"
+ (=
+ :args (number &rest numbers)
+ :eval (= 4 4)
+ :eval (= 4.0 4.0)
+ :eval (= 4 5 6 7))
+ (eq
+ :eval (eq 4 4)
+ :eval (eq 4.0 4.0))
+ (eql
+ :eval (eql 4 4)
+ :eval (eql 4 "4")
+ :eval (eql 4.0 4.0))
+ (/=
+ :eval (/= 4 4))
+ (<
+ :args (number &rest numbers)
+ :eval (< 4 4)
+ :eval (< 1 2 3))
+ (<=
+ :args (number &rest numbers)
+ :eval (<= 4 4)
+ :eval (<= 1 2 3))
+ (>
+ :args (number &rest numbers)
+ :eval (> 4 4)
+ :eval (> 1 2 3))
+ (>=
+ :args (number &rest numbers)
+ :eval (>= 4 4)
+ :eval (>= 1 2 3))
+ (zerop
+ :eval (zerop 0))
+ (cl-plusp
+ :eval (cl-plusp 0)
+ :eval (cl-plusp 1))
+ (cl-minusp
+ :eval (cl-minusp 0)
+ :eval (cl-minusp -1))
+ (cl-oddp
+ :eval (cl-oddp 3))
+ (cl-evenp
+ :eval (cl-evenp 6))
+ (natnump
+ :eval (natnump -1)
+ :eval (natnump 23))
+ (bignump
+ :eval (bignump 4)
+ :eval (bignump (expt 2 90)))
+ (fixnump
+ :eval (fixnump 4)
+ :eval (fixnump (expt 2 90)))
+ (floatp
+ :eval (floatp 5.4))
+ (integerp
+ :eval (integerp 5.4))
+ (numberp
+ :eval (numberp "5.4"))
+ (cl-digit-char-p
+ :eval (cl-digit-char-p ?5 10)
+ :eval (cl-digit-char-p ?f 16))
+ "Operations"
+ (max
+ :args (number &rest numbers)
+ :eval (max 7 9 3))
+ (min
+ :args (number &rest numbers)
+ :eval (min 7 9 3))
+ (abs
+ :eval (abs -4))
+ (float
+ :eval (float 2))
+ (truncate
+ :eval (truncate 1.2)
+ :eval (truncate -1.2)
+ :eval (truncate 5.4 2))
+ (floor
+ :eval (floor 1.2)
+ :eval (floor -1.2)
+ :eval (floor 5.4 2))
+ (ceiling
+ :eval (ceiling 1.2)
+ :eval (ceiling -1.2)
+ :eval (ceiling 5.4 2))
+ (round
+ :eval (round 1.2)
+ :eval (round -1.2)
+ :eval (round 5.4 2))
+ (random
+ :eval (random 6))
+ "Bit Operations"
+ (ash
+ :eval (ash 1 4)
+ :eval (ash 16 -1))
+ (lsh
+ :eval (lsh 1 4)
+ :eval (lsh 16 -1))
+ (logand
+ :no-eval "(logand #b10 #b111)"
+ :result-string "#b10")
+ (logior
+ :eval (logior 4 16))
+ (logxor
+ :eval (logxor 4 16))
+ (lognot
+ :eval (lognot 5))
+ (logcount
+ :eval (logcount 5))
+ "Floating Point"
+ (isnan
+ :eval (isnan 5.0))
+ (frexp
+ :eval (frexp 5.7))
+ (ldexp
+ :eval (ldexp 0.7125 3))
+ (logb
+ :eval (logb 10.5))
+ (ffloor
+ :eval (floor 1.2))
+ (fceiling
+ :eval (fceiling 1.2))
+ (ftruncate
+ :eval (ftruncate 1.2))
+ (fround
+ :eval (fround 1.2))
+ "Standard Math Functions"
+ (sin
+ :eval (sin float-pi))
+ (cos
+ :eval (cos float-pi))
+ (tan
+ :eval (tan float-pi))
+ (asin
+ :eval (asin float-pi))
+ (acos
+ :eval (acos float-pi))
+ (atan
+ :eval (atan float-pi))
+ (exp
+ :eval (exp 4))
+ (log
+ :eval (log 54.59))
+ (expt
+ :eval (expt 2 16))
+ (sqrt
+ :eval (sqrt -1)))
+
+;;;###autoload
+(defun shortdoc-display-group (group)
+ "Pop to a buffer with short documentation summary for functions in GROUP."
+ (interactive (list (completing-read "Show summary for functions in: "
+ (mapcar #'car shortdoc--groups))))
+ (when (stringp group)
+ (setq group (intern group)))
+ (unless (assq group shortdoc--groups)
+ (error "No such documentation group %s" group))
+ (pop-to-buffer (format "*Shortdoc %s*" group))
+ (let ((inhibit-read-only t)
+ (prev nil))
+ (erase-buffer)
+ (shortdoc-mode)
+ (button-mode)
+ (mapc
+ (lambda (data)
+ (cond
+ ((stringp data)
+ (setq prev nil)
+ (unless (bobp)
+ (insert "\n"))
+ (insert (propertize
+ (concat (substitute-command-keys data) "\n\n")
+ 'face '(variable-pitch (:height 1.3 :weight bold))
+ 'shortdoc-section t)))
+ ;; There may be functions not yet defined in the data.
+ ((fboundp (car data))
+ (when prev
+ (insert (propertize "\n" 'face 'shortdoc-separator)))
+ (setq prev t)
+ (shortdoc--display-function data))))
+ (cdr (assq group shortdoc--groups))))
+ (goto-char (point-min)))
+
+(defun shortdoc--display-function (data)
+ (let ((function (pop data))
+ (start-section (point))
+ arglist-start)
+ ;; Function calling convention.
+ (insert (propertize "("
+ 'shortdoc-function t))
+ (if (plist-get data :no-manual)
+ (insert (symbol-name function))
+ (insert-text-button
+ (symbol-name function)
+ 'face 'button
+ 'action (lambda (_)
+ (info-lookup-symbol function 'emacs-lisp-mode))))
+ (setq arglist-start (point))
+ (insert ")\n")
+ ;; Doc string.
+ (insert " "
+ (or (plist-get data :doc)
+ (car (split-string (documentation function) "\n"))))
+ (insert "\n")
+ (add-face-text-property start-section (point) 'shortdoc-section t)
+ (let ((print-escape-newlines t)
+ (double-arrow (if (char-displayable-p ?⇒)
+ "⇒"
+ "=>"))
+ (single-arrow (if (char-displayable-p ?→)
+ "→"
+ "->")))
+ (cl-loop for (type value) on data by #'cddr
+ do
+ (cl-case type
+ (:eval
+ (if (stringp value)
+ (insert " " value "\n")
+ (insert " ")
+ (prin1 value (current-buffer))
+ (insert "\n")
+ (insert " " double-arrow " ")
+ (prin1 (eval value) (current-buffer))
+ (insert "\n")))
+ (:no-eval*
+ (if (stringp value)
+ (insert " " value "\n")
+ (insert " ")
+ (prin1 value (current-buffer)))
+ (insert "\n " single-arrow " "
+ (propertize "[it depends]"
+ 'face 'variable-pitch)
+ "\n"))
+ (:no-value
+ (if (stringp value)
+ (insert " " value)
+ (insert " ")
+ (prin1 value (current-buffer)))
+ (insert "\n"))
+ (:no-eval
+ (if (stringp value)
+ (insert " " value)
+ (insert " ")
+ (prin1 value (current-buffer)))
+ (insert "\n"))
+ (:result
+ (insert " " double-arrow " ")
+ (prin1 value (current-buffer))
+ (insert "\n"))
+ (:result-string
+ (insert " " double-arrow " ")
+ (princ value (current-buffer))
+ (insert "\n"))
+ (:eg-result
+ (insert " eg. " double-arrow " ")
+ (prin1 value (current-buffer))
+ (insert "\n"))
+ (:eg-result-string
+ (insert " eg. " double-arrow " ")
+ (princ value (current-buffer))
+ (insert "\n")))))
+ ;; Insert the arglist after doing the evals, in case that's pulled
+ ;; in the function definition.
+ (save-excursion
+ (goto-char arglist-start)
+ (dolist (param (or (plist-get data :args)
+ (help-function-arglist function t)))
+ (insert " " (symbol-name param)))
+ (add-face-text-property arglist-start (point) 'shortdoc-section t))))
+
+(defun shortdoc-function-groups (function)
+ "Return all shortdoc groups FUNCTION appears in."
+ (cl-loop for group in shortdoc--groups
+ when (assq function (cdr group))
+ collect (car group)))
+
+(defun shortdoc-add-function (group section elem)
+ "Add ELEM to shortdoc GROUP in SECTION.
+If GROUP doesn't exist, it will be created.
+If SECTION doesn't exist, it will be added.
+
+Example:
+
+ (shortdoc-add-function
+ 'file \"Predicates\"
+ '(file-locked-p :no-eval (file-locked-p \"/tmp\")))"
+ (let ((glist (assq group shortdoc--groups)))
+ (unless glist
+ (setq glist (list group))
+ (setq shortdoc--groups (append shortdoc--groups (list glist))))
+ (let ((slist (member section glist)))
+ (unless slist
+ (setq slist (list section))
+ (setq slist (append glist slist)))
+ (while (and (cdr slist)
+ (not (stringp (cadr slist))))
+ (setq slist (cdr slist)))
+ (setcdr slist (cons elem (cdr slist))))))
+
+(defvar shortdoc-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "n") 'shortdoc-next)
+ (define-key map (kbd "p") 'shortdoc-previous)
+ (define-key map (kbd "C-c C-n") 'shortdoc-next-section)
+ (define-key map (kbd "C-c C-p") 'shortdoc-previous-section)
+ map)
+ "Keymap for `shortdoc-mode'")
+
+(define-derived-mode shortdoc-mode special-mode "shortdoc"
+ "Mode for shortdoc.")
+
+(defmacro shortdoc--goto-section (arg sym &optional reverse)
+ `(progn
+ (unless (natnump ,arg)
+ (setq ,arg 1))
+ (while (< 0 ,arg)
+ (,(if reverse
+ 'text-property-search-backward
+ 'text-property-search-forward)
+ ,sym t)
+ (setq ,arg (1- ,arg)))))
+
+(defun shortdoc-next (&optional arg)
+ "Move cursor to next function."
+ (interactive "p")
+ (shortdoc--goto-section arg 'shortdoc-function))
+
+(defun shortdoc-previous (&optional arg)
+ "Move cursor to previous function."
+ (interactive "p")
+ (shortdoc--goto-section arg 'shortdoc-function t)
+ (backward-char 1))
+
+(defun shortdoc-next-section (&optional arg)
+ "Move cursor to next section."
+ (interactive "p")
+ (shortdoc--goto-section arg 'shortdoc-section))
+
+(defun shortdoc-previous-section (&optional arg)
+ "Move cursor to previous section."
+ (interactive "p")
+ (shortdoc--goto-section arg 'shortdoc-section t)
+ (forward-line -2))
+
+(provide 'shortdoc)
+
+;;; shortdoc.el ends here
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 60d8fa591e9..1b700afd12d 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -52,6 +52,13 @@
;; error because the parser just automatically does something. Better yet,
;; we can afford to use a sloppy grammar.
+;; The benefits of this approach were presented in the following article,
+;; which includes a kind of tutorial to get started with SMIE:
+;;
+;; SMIE: Weakness is Power! Auto-indentation with incomplete information
+;; Stefan Monnier, <Programming> Journal 2020, volumn 5, issue 1.
+;; doi: 10.22152/programming-journal.org/2020/5/1
+
;; A good background to understand the development (especially the parts
;; building the 2D precedence tables and then computing the precedence levels
;; from it) can be found in pages 187-194 of "Parsing techniques" by Dick Grune
@@ -63,6 +70,7 @@
;; Since then, some of that code has been beaten into submission, but the
;; smie-indent-keyword is still pretty obscure.
+
;; Conflict resolution:
;;
;; - One source of conflicts is when you have:
@@ -1356,9 +1364,9 @@ Only meaningful when called from within `smie-rules-function'."
(funcall smie-rules-function :elem 'basic))
smie-indent-basic))
-(defun smie-indent--rule (method token
- ;; FIXME: Too many parameters.
- &optional after parent base-pos)
+(defun smie-indent--rule ( method token
+ ;; FIXME: Too many parameters.
+ &optional after parent base-pos)
"Compute indentation column according to `smie-rules-function'.
METHOD and TOKEN are passed to `smie-rules-function'.
AFTER is the position after TOKEN, if known.
@@ -2112,10 +2120,9 @@ position corresponding to each rule."
(throw 'found (list kind token
(or (nth 3 rewrite) res)))))))))
(default-new (smie-config--guess-value sig))
- (newstr (read-string (format "Adjust rule (%S %S -> %S) to%s: "
- (nth 0 sig) (nth 1 sig) (nth 2 sig)
- (if (not default-new) ""
- (format " (default %S)" default-new)))
+ (newstr (read-string (format-prompt
+ "Adjust rule (%S %S -> %S) to" default-new
+ (nth 0 sig) (nth 1 sig) (nth 2 sig))
nil nil (format "%S" default-new)))
(new (car (read-from-string newstr))))
(let ((old (rassoc sig smie-config--buffer-local)))
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 044c9aada0d..e6abb39ddc6 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -156,6 +156,7 @@ are non-nil, then the result is non-nil."
,@(or body `(,res))))
`(let* () ,@(or body '(t))))))
+;;;###autoload
(defmacro if-let (spec then &rest else)
"Bind variables according to SPEC and evaluate THEN or ELSE.
Evaluate each binding in turn, as in `let*', stopping if a
@@ -236,6 +237,15 @@ REGEXP defaults to \"[ \\t\\n\\r]+\"."
TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
(string-trim-left (string-trim-right string trim-right) trim-left))
+;;;###autoload
+(defun string-truncate-left (string length)
+ "Truncate STRING to LENGTH, replacing initial surplus with \"...\"."
+ (let ((strlen (length string)))
+ (if (<= strlen length)
+ string
+ (setq length (max 0 (- length 3)))
+ (concat "..." (substring string (max 0 (- strlen 1 length)))))))
+
(defsubst string-blank-p (string)
"Check whether STRING is either empty or only whitespace.
The following characters count as whitespace here: space, tab, newline and
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index f4f077264be..62f1b16d75c 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -63,9 +63,10 @@ override the buffer's syntax table for special syntactic constructs that
cannot be handled just by the buffer's syntax-table.
The specified function may call `syntax-ppss' on any position
-before END, but it should not call `syntax-ppss-flush-cache',
-which means that it should not call `syntax-ppss' on some
-position and later modify the buffer on some earlier position.
+before END, but if it calls `syntax-ppss' on some
+position and later modifies the buffer on some earlier position,
+then it is its responsibility to call `syntax-ppss-flush-cache' to flush
+the now obsolete ppss info from the cache.
Note: When this variable is a function, it must apply _all_ the
`syntax-table' properties needed in the given text interval.
@@ -143,14 +144,28 @@ delimiter or an Escaped or Char-quoted character."))
(point-max))))
(cons beg end))
-(defun syntax-propertize--shift-groups (re n)
- (replace-regexp-in-string
- "\\\\(\\?\\([0-9]+\\):"
- (lambda (s)
- (replace-match
- (number-to-string (+ n (string-to-number (match-string 1 s))))
- t t s 1))
- re t t))
+(defun syntax-propertize--shift-groups-and-backrefs (re n)
+ (let ((new-re (replace-regexp-in-string
+ "\\\\(\\?\\([0-9]+\\):"
+ (lambda (s)
+ (replace-match
+ (number-to-string
+ (+ n (string-to-number (match-string 1 s))))
+ t t s 1))
+ re t t))
+ (pos 0))
+ (while (string-match "\\\\\\([0-9]+\\)" new-re pos)
+ (setq pos (+ 1 (match-beginning 1)))
+ (when (save-match-data
+ ;; With \N, the \ must be in a subregexp context, i.e.,
+ ;; not in a character class or in a \{\} repetition.
+ (subregexp-context-p new-re (match-beginning 0)))
+ (let ((shifted (+ n (string-to-number (match-string 1 new-re)))))
+ (when (> shifted 9)
+ (error "There may be at most nine back-references"))
+ (setq new-re (replace-match (number-to-string shifted)
+ t t new-re 1)))))
+ new-re))
(defmacro syntax-propertize-precompile-rules (&rest rules)
"Return a precompiled form of RULES to pass to `syntax-propertize-rules'.
@@ -194,7 +209,8 @@ for subsequent HIGHLIGHTs.
Also SYNTAX is free to move point, in which case RULES may not be applied to
some parts of the text or may be applied several times to other parts.
-Note: back-references in REGEXPs do not work."
+Note: There may be at most nine back-references in the REGEXPs of
+all RULES in total."
(declare (debug (&rest &or symbolp ;FIXME: edebug this eval step.
(form &rest
(numberp
@@ -223,7 +239,7 @@ Note: back-references in REGEXPs do not work."
;; tell when *this* match 0 has succeeded.
(cl-incf offset)
(setq re (concat "\\(" re "\\)")))
- (setq re (syntax-propertize--shift-groups re offset))
+ (setq re (syntax-propertize--shift-groups-and-backrefs re offset))
(let ((code '())
(condition
(cond
@@ -325,6 +341,11 @@ END) suitable for `syntax-propertize-function'."
(defvar-local syntax-ppss-table nil
"Syntax-table to use during `syntax-ppss', if any.")
+(defvar-local syntax-propertize--inhibit-flush nil
+ "If non-nil, `syntax-ppss-flush-cache' only flushes the ppss cache.
+Otherwise it flushes both the ppss cache and the properties
+set by `syntax-propertize'")
+
(defun syntax-propertize (pos)
"Ensure that syntax-table properties are set until POS (a buffer point)."
(when (< syntax-propertize--done pos)
@@ -350,23 +371,27 @@ END) suitable for `syntax-propertize-function'."
(end (max pos
(min (point-max)
(+ start syntax-propertize-chunk-size))))
- (funs syntax-propertize-extend-region-functions))
- (while funs
- (let ((new (funcall (pop funs) start end))
- ;; Avoid recursion!
- (syntax-propertize--done most-positive-fixnum))
- (if (or (null new)
- (and (>= (car new) start) (<= (cdr new) end)))
- nil
- (setq start (car new))
- (setq end (cdr new))
- ;; If there's been a change, we should go through the
- ;; list again since this new position may
- ;; warrant a different answer from one of the funs we've
- ;; already seen.
- (unless (eq funs
- (cdr syntax-propertize-extend-region-functions))
- (setq funs syntax-propertize-extend-region-functions)))))
+ (first t)
+ (repeat t))
+ (while repeat
+ (setq repeat nil)
+ (run-hook-wrapped
+ 'syntax-propertize-extend-region-functions
+ (lambda (f)
+ (let ((new (funcall f start end))
+ ;; Avoid recursion!
+ (syntax-propertize--done most-positive-fixnum))
+ (if (or (null new)
+ (and (>= (car new) start) (<= (cdr new) end)))
+ nil
+ (setq start (car new))
+ (setq end (cdr new))
+ ;; If there's been a change, we should go through the
+ ;; list again since this new position may
+ ;; warrant a different answer from one of the funs we've
+ ;; already seen.
+ (unless first (setq repeat t))))
+ (setq first nil))))
;; Flush ppss cache between the original value of `start' and that
;; set above by syntax-propertize-extend-region-functions.
(syntax-ppss-flush-cache start)
@@ -376,8 +401,13 @@ END) suitable for `syntax-propertize-function'."
;; (message "syntax-propertizing from %s to %s" start end)
(remove-text-properties start end
'(syntax-table nil syntax-multiline nil))
- ;; Avoid recursion!
- (let ((syntax-propertize--done most-positive-fixnum))
+ ;; Make sure we only let-bind it buffer-locally.
+ (make-local-variable 'syntax-propertize--inhibit-flush)
+ ;; Let-bind `syntax-propertize--done' to avoid infinite recursion!
+ (let ((syntax-propertize--done most-positive-fixnum)
+ ;; Let `syntax-propertize-function' call
+ ;; `syntax-ppss-flush-cache' without worries.
+ (syntax-propertize--inhibit-flush t))
(funcall syntax-propertize-function start end)))))))))
;;; Link syntax-propertize with syntax.c.
@@ -456,7 +486,8 @@ These are valid when the buffer has no restriction.")
(defun syntax-ppss-flush-cache (beg &rest ignored)
"Flush the cache of `syntax-ppss' starting at position BEG."
;; Set syntax-propertize to refontify anything past beg.
- (setq syntax-propertize--done (min beg syntax-propertize--done))
+ (unless syntax-propertize--inhibit-flush
+ (setq syntax-propertize--done (min beg syntax-propertize--done)))
;; Flush invalid cache entries.
(dolist (cell (list syntax-ppss-wide syntax-ppss-narrow))
(pcase cell
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 501cc3a29e0..30577679f24 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -269,42 +269,48 @@ Populated by `tabulated-list-init-header'.")
;; FIXME: Should share code with tabulated-list-print-col!
(let ((x (max tabulated-list-padding 0))
(button-props `(help-echo "Click to sort by column"
- mouse-face header-line-highlight
- keymap ,tabulated-list-sort-button-map))
+ mouse-face header-line-highlight
+ keymap ,tabulated-list-sort-button-map))
+ (len (length tabulated-list-format))
(cols nil))
(if display-line-numbers
(setq x (+ x (tabulated-list-line-number-width))))
(push (propertize " " 'display `(space :align-to ,x)) cols)
- (dotimes (n (length tabulated-list-format))
+ (dotimes (n len)
(let* ((col (aref tabulated-list-format n))
+ (not-last-col (< n (1- len)))
(label (nth 0 col))
+ (lablen (length label))
+ (pname label)
(width (nth 1 col))
(props (nthcdr 3 col))
(pad-right (or (plist-get props :pad-right) 1))
(right-align (plist-get props :right-align))
(next-x (+ x pad-right width)))
+ (when (and (>= lablen 3) (> lablen width) not-last-col)
+ (setq label (truncate-string-to-width label (- lablen 1) nil nil t)))
(push
(cond
;; An unsortable column
((not (nth 2 col))
- (propertize label 'tabulated-list-column-name label))
+ (propertize label 'tabulated-list-column-name pname))
;; The selected sort column
((equal (car col) (car tabulated-list-sort-key))
(apply 'propertize
- (concat label
- (cond
- ((> (+ 2 (length label)) width) "")
- ((cdr tabulated-list-sort-key)
+ (concat label
+ (cond
+ ((and (< lablen 3) not-last-col) "")
+ ((cdr tabulated-list-sort-key)
(format " %c"
tabulated-list-gui-sort-indicator-desc))
- (t (format " %c"
+ (t (format " %c"
tabulated-list-gui-sort-indicator-asc))))
- 'face 'bold
- 'tabulated-list-column-name label
- button-props))
+ 'face 'bold
+ 'tabulated-list-column-name pname
+ button-props))
;; Unselected sortable column.
(t (apply 'propertize label
- 'tabulated-list-column-name label
+ 'tabulated-list-column-name pname
button-props)))
cols)
(when right-align
@@ -547,10 +553,10 @@ Return the column number after insertion."
;; Don't truncate to `width' if the next column is align-right
;; and has some space left, truncate to `available-space' instead.
(when (and not-last-col
- (> label-width available-space)
- (setq label (truncate-string-to-width
- label available-space nil nil t t)
- label-width available-space)))
+ (> label-width available-space))
+ (setq label (truncate-string-to-width
+ label available-space nil nil t t)
+ label-width available-space))
(setq label (bidi-string-mark-left-to-right label))
(when (and right-align (> width label-width))
(let ((shift (- width label-width)))
diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/lisp/emacs-lisp/tcover-unsafep.el
deleted file mode 100644
index 108dee3d95d..00000000000
--- a/lisp/emacs-lisp/tcover-unsafep.el
+++ /dev/null
@@ -1,140 +0,0 @@
-;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage
-
-;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
-
-;; Author: Jonathan Yavner <jyavner@member.fsf.org>
-;; Keywords: safety lisp utility
-;; Package: testcover
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-(require 'testcover)
-
-(defvar safe-functions)
-
-;;;These forms are all considered safe
-(defconst testcover-unsafep-safe
- '(((lambda (x) (* x 2)) 14)
- (apply 'cdr (mapcar (lambda (x) (car x)) y))
- (cond ((= x 4) 5) (t 27))
- (condition-case x (car y) (error (car x)))
- (dolist (x y) (message "here: %s" x))
- (dotimes (x 14 (* x 2)) (message "here: %d" x))
- (let (x) (dolist (y '(1 2 3) (1+ y)) (push y x)))
- (let (x) (apply (lambda (x) (* x 2)) 14))
- (let ((x '(2))) (push 1 x) (pop x) (add-to-list 'x 2))
- (let ((x 1) (y 2)) (setq x (+ x y)))
- (let ((x 1)) (let ((y (+ x 3))) (* x y)))
- (let* nil (current-time))
- (let* ((x 1) (y (+ x 3))) (* x y))
- (mapcar (lambda (x &optional y &rest z) (setq y (+ x 2)) (* y 3)) '(1 2 3))
- (mapconcat #'(lambda (var) (propertize var 'face 'bold)) '("1" "2") ", ")
- (setq buffer-display-count 14 mark-active t)
- ;;This is not safe if you insert it into a buffer!
- (propertize "x" 'display '(height (progn (delete-file "x") 1))))
- "List of forms that `unsafep' should decide are safe.")
-
-;;;These forms are considered unsafe
-(defconst testcover-unsafep-unsafe
- '(( (add-to-list x y)
- . (unquoted x))
- ( (add-to-list y x)
- . (unquoted y))
- ( (add-to-list 'y x)
- . (global-variable y))
- ( (not (delete-file "unsafep.el"))
- . (function delete-file))
- ( (cond (t (aset local-abbrev-table 0 0)))
- . (function aset))
- ( (cond (t (setq unsafep-vars "")))
- . (risky-local-variable unsafep-vars))
- ( (condition-case format-alist 1)
- . (risky-local-variable format-alist))
- ( (condition-case x 1 (error (setq format-alist "")))
- . (risky-local-variable format-alist))
- ( (dolist (x (sort globalvar 'car)) (princ x))
- . (function sort))
- ( (dotimes (x 14) (delete-file "x"))
- . (function delete-file))
- ( (let ((post-command-hook "/tmp/")) 1)
- . (risky-local-variable post-command-hook))
- ( (let ((x (delete-file "x"))) 2)
- . (function delete-file))
- ( (let (x) (add-to-list 'x (delete-file "x")))
- . (function delete-file))
- ( (let (x) (condition-case y (setq x 1 z 2)))
- . (global-variable z))
- ( (let (x) (condition-case z 1 (error (delete-file "x"))))
- . (function delete-file))
- ( (let (x) (mapc (lambda (x) (setcar x 1)) '((1 . 2) (3 . 4))))
- . (function setcar))
- ( (let (y) (push (delete-file "x") y))
- . (function delete-file))
- ( (let* ((x 1)) (setq y 14))
- . (global-variable y))
- ( (mapc 'car (list '(1 . 2) (cons 3 4) (kill-buffer "unsafep.el")))
- . (function kill-buffer))
- ( (mapcar x y)
- . (unquoted x))
- ( (mapcar (lambda (x) (rename-file x "x")) '("unsafep.el"))
- . (function rename-file))
- ( (mapconcat x1 x2 " ")
- . (unquoted x1))
- ( (pop format-alist)
- . (risky-local-variable format-alist))
- ( (push 1 format-alist)
- . (risky-local-variable format-alist))
- ( (setq buffer-display-count (delete-file "x"))
- . (function delete-file))
- ;;These are actually safe (they signal errors)
- ( (apply '(x) '(1 2 3))
- . (function (x)))
- ( (let (((x))) 1)
- . (variable (x)))
- ( (let (1) 2)
- . (variable 1))
- )
- "A-list of (FORM . REASON)... that`unsafep' should decide are unsafe.")
-
-(declare-function unsafep-function "unsafep" (fun))
-
-;;;#########################################################################
-(defun testcover-unsafep ()
- "Executes all unsafep tests and displays the coverage results."
- (interactive)
- (testcover-unmark-all "unsafep.el")
- (testcover-start "unsafep.el")
- (let (save-functions)
- (dolist (x testcover-unsafep-safe)
- (if (unsafep x)
- (error "%S should be safe" x)))
- (dolist (x testcover-unsafep-unsafe)
- (if (not (equal (unsafep (car x)) (cdr x)))
- (error "%S should be unsafe: %s" (car x) (cdr x))))
- (setq safe-functions t)
- (if (or (unsafep '(delete-file "x"))
- (unsafep-function 'delete-file))
- (error "safe-functions=t should allow delete-file"))
- (setq safe-functions '(setcar))
- (if (unsafep '(setcar x 1))
- (error "safe-functions=(setcar) should allow setcar"))
- (if (not (unsafep '(setcdr x 1)))
- (error "safe-functions=(setcar) should not allow setcdr")))
- (testcover-mark-all "unsafep.el")
- (testcover-end "unsafep.el")
- (message "Done"))
-
-;; testcover-unsafep.el ends here.
diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el
index b6e98f59a7a..d7dc7da7c18 100644
--- a/lisp/emacs-lisp/text-property-search.el
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -34,11 +34,11 @@
"Search for the next region of text whose PROPERTY matches VALUE.
If not found, return nil and don't move point.
-If found, move point to end of the region and return a `prop-match'
-object describing the match. To access the details of the match,
-use `prop-match-beginning' and `prop-match-end' for the buffer
-positions that limit the region, and `prop-match-value' for the
-value of PROPERTY in the region.
+If found, move point to the start of the region and return a
+`prop-match' object describing the match. To access the details
+of the match, use `prop-match-beginning' and `prop-match-end' for
+the buffer positions that limit the region, and
+`prop-match-value' for the value of PROPERTY in the region.
PREDICATE is used to decide whether a value of PROPERTY should be
considered as matching VALUE.
@@ -125,7 +125,7 @@ that matches VALUE."
"Search for the previous region of text whose PROPERTY matches VALUE.
Like `text-property-search-forward', which see, but searches backward,
-and if a matching region is found, moves point to its beginning."
+and if a matching region is found, place point at its end."
(interactive
(list
(let ((string (completing-read "Search for property: " obarray)))
@@ -137,11 +137,19 @@ and if a matching region is found, moves point to its beginning."
nil)
;; We're standing in the property we're looking for, so find the
;; end.
- ((and (text-property--match-p
- value (get-text-property (1- (point)) property)
- predicate)
- (not not-current))
- (text-property--find-end-backward (1- (point)) property value predicate))
+ ((text-property--match-p
+ value (get-text-property (1- (point)) property)
+ predicate)
+ (let ((origin (point))
+ (match (text-property--find-end-backward
+ (1- (point)) property value predicate)))
+ ;; When we want to ignore the current element, then repeat the
+ ;; search if we haven't moved out of it yet.
+ (if (and not-current
+ (equal (get-text-property (point) property)
+ (get-text-property origin property)))
+ (text-property-search-backward property value predicate)
+ match)))
(t
(let ((origin (point))
(ended nil)
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index 4fa31f32673..024f0030629 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -32,41 +32,51 @@
"List all timers in a buffer."
(interactive)
(pop-to-buffer-same-window (get-buffer-create "*timer-list*"))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (timer-list-mode)
- (dolist (timer (append timer-list timer-idle-list))
- (insert (format "%4s %10s %8s %s"
- ;; Idle.
- (if (aref timer 7) "*" " ")
- ;; Next time.
- (let ((time (list (aref timer 1)
- (aref timer 2)
- (aref timer 3))))
- (format "%.2f"
- (float-time
- (if (aref timer 7)
- time
- (time-subtract time nil)))))
- ;; Repeat.
- (let ((repeat (aref timer 4)))
- (cond
- ((numberp repeat)
- (format "%.2f" (/ repeat 60)))
- ((null repeat)
- "-")
- (t
- (format "%s" repeat))))
- ;; Function.
- (let ((cl-print-compiled 'static)
- (cl-print-compiled-button nil)
- (print-escape-newlines t))
- (cl-prin1-to-string (aref timer 5)))))
- (put-text-property (line-beginning-position)
- (1+ (line-beginning-position))
- 'timer timer)
- (insert "\n")))
- (goto-char (point-min)))
+ (timer-list-mode)
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries
+ (mapcar
+ (lambda (timer)
+ (list
+ nil
+ `[ ;; Idle.
+ ,(propertize
+ (if (aref timer 7) " *" " ")
+ 'help-echo "* marks idle timers"
+ 'timer timer)
+ ;; Next time.
+ ,(propertize
+ (let ((time (list (aref timer 1)
+ (aref timer 2)
+ (aref timer 3))))
+ (format "%12s"
+ (format-seconds "%dd %hh %mm %z%,1ss"
+ (float-time
+ (if (aref timer 7)
+ time
+ (time-subtract time nil))))))
+ 'help-echo "Time until next invocation")
+ ;; Repeat.
+ ,(let ((repeat (aref timer 4)))
+ (cond
+ ((numberp repeat)
+ (propertize
+ (format "%12s" (format-seconds
+ "%dd %hh %mm %z%,1ss" repeat))
+ 'help-echo "Repeat interval"))
+ ((null repeat)
+ (propertize " -" 'help-echo "Runs once"))
+ (t
+ (format "%12s" repeat))))
+ ;; Function.
+ ,(propertize
+ (let ((cl-print-compiled 'static)
+ (cl-print-compiled-button nil)
+ (print-escape-newlines t))
+ (cl-prin1-to-string (aref timer 5)))
+ 'help-echo "Function called by timer")]))
+ (append timer-list timer-idle-list)))
+ (tabulated-list-print))
;; This command can be destructive if they don't know what they are
;; doing. Kids, don't try this at home!
;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
@@ -74,24 +84,47 @@
(defvar timer-list-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "c" 'timer-list-cancel)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
(easy-menu-define nil map ""
'("Timers"
["Cancel" timer-list-cancel t]))
map))
-(define-derived-mode timer-list-mode special-mode "Timer-List"
+(define-derived-mode timer-list-mode tabulated-list-mode "Timer-List"
"Mode for listing and controlling timers."
- (setq bidi-paragraph-direction 'left-to-right)
- (setq truncate-lines t)
(buffer-disable-undo)
(setq-local revert-buffer-function #'list-timers)
- (setq buffer-read-only t)
- (setq header-line-format
- (concat (propertize " " 'display '(space :align-to 0))
- (format "%4s %10s %8s %s"
- "Idle" "Next" "Repeat" "Function"))))
+ (setq tabulated-list-format
+ '[("Idle" 6 timer-list--idle-predicate)
+ ("Next" 12 timer-list--next-predicate :right-align t :pad-right 1)
+ ("Repeat" 12 timer-list--repeat-predicate :right-align t :pad-right 1)
+ ("Function" 10 timer-list--function-predicate)]))
+
+(defun timer-list--idle-predicate (A B)
+ "Predicate to sort Timer-List by the Idle column."
+ (let ((iA (aref (cadr A) 0))
+ (iB (aref (cadr B) 0)))
+ (cond ((string= iA iB)
+ (timer-list--next-predicate A B))
+ ((string= iA " *") nil)
+ (t t))))
+
+(defun timer-list--next-predicate (A B)
+ "Predicate to sort Timer-List by the Next column."
+ (let ((nA (string-to-number (aref (cadr A) 1)))
+ (nB (string-to-number (aref (cadr B) 1))))
+ (< nA nB)))
+
+(defun timer-list--repeat-predicate (A B)
+ "Predicate to sort Timer-List by the Repeat column."
+ (let ((rA (aref (cadr A) 2))
+ (rB (aref (cadr B) 2)))
+ (string< rA rB)))
+
+(defun timer-list--function-predicate (A B)
+ "Predicate to sort Timer-List by the Function column."
+ (let ((fA (aref (cadr A) 3))
+ (fB (aref (cadr B) 3)))
+ (string< fA fB)))
(defun timer-list-cancel ()
"Cancel the timer on the line under point."
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 9eb8feed0f1..61fd05cbb80 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -378,9 +378,6 @@ This function returns a timer object which you can use in
(decoded-time-year now)
(decoded-time-zone now)))))))
- (or (time-equal-p time time)
- (error "Invalid time format"))
-
(let ((timer (timer-create)))
(timer-set-time timer time repeat)
(timer-set-function timer function args)
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index 4ebb7ff711d..627305689c7 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -265,20 +265,13 @@ be printed along with the arguments in the trace."
If `current-prefix-arg' is non-nil, also read a buffer and a \"context\"
\(Lisp expression). Return (FUNCTION BUFFER FUNCTION-CONTEXT)."
(cons
- (let ((default (function-called-at-point))
- (beg (string-match ":[ \t]*\\'" prompt)))
- (intern (completing-read (if default
- (format
- "%s (default %s)%s"
- (substring prompt 0 beg)
- default
- (if beg (substring prompt beg) ": "))
- prompt)
+ (let ((default (function-called-at-point)))
+ (intern (completing-read (format-prompt prompt default)
obarray 'fboundp t nil nil
(if default (symbol-name default)))))
(when current-prefix-arg
(list
- (read-buffer "Output to buffer: " trace-buffer)
+ (read-buffer (format-prompt "Output to buffer" trace-buffer))
(let ((exp
(let ((minibuffer-completing-symbol t))
(read-from-minibuffer "Context expression: "
@@ -308,7 +301,7 @@ functions that switch buffers, or do any other display-oriented
stuff - use `trace-function-background' instead.
To stop tracing a function, use `untrace-function' or `untrace-all'."
- (interactive (trace--read-args "Trace function: "))
+ (interactive (trace--read-args "Trace function"))
(trace-function-internal function buffer nil context))
;;;###autoload
@@ -316,7 +309,7 @@ To stop tracing a function, use `untrace-function' or `untrace-all'."
"Trace calls to function FUNCTION, quietly.
This is like `trace-function-foreground', but without popping up
the output buffer or changing the window configuration."
- (interactive (trace--read-args "Trace function in background: "))
+ (interactive (trace--read-args "Trace function in background"))
(trace-function-internal function buffer t context))
;;;###autoload
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index e7077140e54..c4db86a0db3 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -91,17 +91,41 @@
in the parse.")
(put 'unsafep-vars 'risky-local-variable t)
-;;Other safe functions
+;; Other safe forms.
+;;
+;; A function, macro or special form may be put here only if all of
+;; the following statements are true:
+;;
+;; * It is not already marked `pure' or `side-effect-free', or handled
+;; explicitly by `unsafep'.
+;;
+;; * It is not inherently unsafe; eg, would allow the execution of
+;; arbitrary code, interact with the file system, network or other
+;; processes, or otherwise exfiltrate information from the running
+;; Emacs process or manipulate the user's environment.
+;;
+;; * It does not have side-effects that can make other code behave in
+;; unsafe and/or unexpected ways; eg, set variables, mutate data, or
+;; change control flow.
+;; Any side effect must be innocuous; altering the match data is
+;; explicitly permitted.
+;;
+;; * It does not allow Emacs to behave deceptively to the user; eg,
+;; display arbitrary messages.
+;;
+;; * It does not present a potentially large attack surface; eg,
+;; play arbitrary audio files.
+
(dolist (x '(;;Special forms
- and catch if or prog1 prog2 progn while unwind-protect
+ and if or prog1 prog2 progn while unwind-protect
;;Safe subrs that have some side-effects
- ding error random signal sleep-for string-match throw
+ ding random sleep-for string-match
;;Defsubst functions from subr.el
caar cadr cdar cddr
;;Macros from subr.el
save-match-data unless when
;;Functions from subr.el that have side effects
- split-string replace-regexp-in-string play-sound-file))
+ split-string))
(put x 'safe-function t))
;;;###autoload
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index cd960618a0a..f525ea433ad 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -1,4 +1,4 @@
-;;; warnings.el --- log and display warnings
+;;; warnings.el --- log and display warnings -*- lexical-binding:t -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@@ -68,25 +68,25 @@ Each element looks like (ALIAS . LEVEL) and defines ALIAS as
equivalent to LEVEL. LEVEL must be defined in `warning-levels';
it may not itself be an alias.")
-(defvaralias 'display-warning-minimum-level 'warning-minimum-level)
+(define-obsolete-variable-alias 'display-warning-minimum-level
+ 'warning-minimum-level "28.1")
(defcustom warning-minimum-level :warning
"Minimum severity level for displaying the warning buffer.
If a warning's severity level is lower than this,
the warning is logged in the warnings buffer, but the buffer
is not immediately displayed. See also `warning-minimum-log-level'."
- :group 'warnings
:type '(choice (const :emergency) (const :error)
(const :warning) (const :debug))
:version "22.1")
-(defvaralias 'log-warning-minimum-level 'warning-minimum-log-level)
+(define-obsolete-variable-alias 'log-warning-minimum-level
+ 'warning-minimum-log-level "28.1")
(defcustom warning-minimum-log-level :warning
"Minimum severity level for logging a warning.
If a warning severity level is lower than this,
the warning is completely ignored.
Value must be lower or equal than `warning-minimum-level',
because warnings not logged aren't displayed either."
- :group 'warnings
:type '(choice (const :emergency) (const :error)
(const :warning) (const :debug))
:version "22.1")
@@ -100,7 +100,6 @@ Thus, (foo bar) as an element matches (foo bar)
or (foo bar ANYTHING...) as TYPE.
If TYPE is a symbol FOO, that is equivalent to the list (FOO),
so only the element (FOO) will match it."
- :group 'warnings
:type '(repeat (repeat symbol))
:version "22.1")
@@ -115,7 +114,6 @@ or (foo bar ANYTHING...) as TYPE.
If TYPE is a symbol FOO, that is equivalent to the list (FOO),
so only the element (FOO) will match it.
See also `warning-suppress-log-types'."
- :group 'warnings
:type '(repeat (repeat symbol))
:version "22.1")
@@ -202,6 +200,21 @@ SUPPRESS-LIST is the list of kinds of warnings to suppress."
;; we return t.
some-match))
+(define-button-type 'warning-suppress-warning
+ 'action #'warning-suppress-action
+ 'help-echo "mouse-2, RET: Don't display this warning automatically")
+(defun warning-suppress-action (button)
+ (customize-save-variable 'warning-suppress-types
+ (cons (list (button-get button 'warning-type))
+ warning-suppress-types)))
+(define-button-type 'warning-suppress-log-warning
+ 'action #'warning-suppress-log-action
+ 'help-echo "mouse-2, RET: Don't log this warning")
+(defun warning-suppress-log-action (button)
+ (customize-save-variable 'warning-suppress-log-types
+ (cons (list (button-get button 'warning-type))
+ warning-suppress-types)))
+
;;;###autoload
(defun display-warning (type message &optional level buffer-name)
"Display a warning message, MESSAGE.
@@ -229,7 +242,12 @@ See the `warnings' custom group for user customization features.
See also `warning-series', `warning-prefix-function',
`warning-fill-prefix', and `warning-fill-column' for additional
-programming features."
+programming features.
+
+This will also display buttons allowing the user to permanently
+disable automatic display of the warning or disable the warning
+entirely by setting `warning-suppress-types' or
+`warning-suppress-log-types' on their behalf."
(if (not (or after-init-time noninteractive (daemonp)))
;; Ensure warnings that happen early in the startup sequence
;; are visible when startup completes (bug#20792).
@@ -274,6 +292,17 @@ programming features."
(insert (format (nth 1 level-info)
(format warning-type-format typename))
message)
+ ;; Don't output the buttons when doing batch compilation
+ ;; and similar.
+ (unless (or noninteractive (eq type 'bytecomp))
+ (insert " ")
+ (insert-button "Disable showing"
+ 'type 'warning-suppress-warning
+ 'warning-type type)
+ (insert " ")
+ (insert-button "Disable logging"
+ 'type 'warning-suppress-log-warning
+ 'warning-type type))
(funcall newline)
(when (and warning-fill-prefix (not (string-match "\n" message)))
(let ((fill-prefix warning-fill-prefix)
diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index 5f393a01e8c..ba75a93035e 100644
--- a/lisp/emacs-lock.el
+++ b/lisp/emacs-lock.el
@@ -176,11 +176,12 @@ Return a value appropriate for `kill-buffer-query-functions' (which see)."
arg)
((and (eq arg current-prefix-arg) (consp current-prefix-arg))
;; called with C-u M-x emacs-lock-mode, so ask the user
- (intern (completing-read "Locking mode: "
- '("all" "exit" "kill")
- nil t nil nil
- (symbol-name
- emacs-lock-default-locking-mode))))
+ (intern (completing-read
+ (format-prompt "Locking mode"
+ emacs-lock-default-locking-mode)
+ '("all" "exit" "kill")
+ nil t nil nil
+ (symbol-name emacs-lock-default-locking-mode))))
((eq mode t)
;; turn on, so use previous setting, or customized default
(or emacs-lock--old-mode emacs-lock-default-locking-mode))
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 26a1a8955f4..926305e6077 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -860,7 +860,7 @@ With numeric prefix arg, copy to register 0-9 instead."
(defun cua-cancel ()
"Cancel the active region, rectangle, or global mark."
(interactive)
- (setq mark-active nil)
+ (deactivate-mark)
(if (fboundp 'cua--cancel-rectangle)
(cua--cancel-rectangle)))
@@ -1379,9 +1379,10 @@ the prefix fallback behavior."
(cond
(cua-mode
- (setq cua--saved-state
- (list
- (and (boundp 'delete-selection-mode) delete-selection-mode)))
+ (unless cua--saved-state
+ (setq cua--saved-state
+ (list
+ (and (boundp 'delete-selection-mode) delete-selection-mode))))
(if cua-delete-selection
(delete-selection-mode 1)
(if (and (boundp 'delete-selection-mode) delete-selection-mode)
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 663995a0a11..7ca9dc1af1d 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -37,26 +37,56 @@
(require 'rect)
-;; If non-nil, restrict current region to this rectangle.
-;; Value is a vector [top bot left right corner ins virt select].
-;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r.
-;; INS specifies whether to insert on left(nil) or right(t) side.
-;; If VIRT is non-nil, virtual straight edges are enabled.
-;; If SELECT is a regexp, only lines starting with that regexp are affected.")
-(defvar cua--rectangle nil)
+(defvar cua--rectangle nil
+ "If non-nil, restrict current region to this rectangle.
+A cua-rectangle definition is a vector used for all actions in
+`cua-rectangle-mark-mode', of the form:
+
+ [top bot left right corner ins virt select]
+
+TOP is the upper-left corner point.
+
+BOTTOM is the point at the end of line after the the lower-right
+corner point.
+
+LEFT and RIGHT are column numbers.
+
+CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r.
+
+INS specifies whether to insert on left(nil) or right(t) side.
+
+If VIRT is non-nil, virtual straight edges are enabled.
+
+If SELECT is a regexp, only lines starting with that regexp are
+affected.")
(make-variable-buffer-local 'cua--rectangle)
-;; Most recent rectangle geometry. Note: car is buffer.
-(defvar cua--last-rectangle nil)
+(defvar cua--last-rectangle nil
+ "Most recent rectangle geometry.
+A CONS cell, the car of which is the rectangle's buffer, and the
+cdr of which is a cua-rectangle definition.
+See `cua--rectangle'.")
+
-;; Rectangle restored by undo.
-(defvar cua--restored-rectangle nil)
+(defvar cua--restored-rectangle nil
+ "Rectangle restored by undo.")
;; Last rectangle copied/killed; nil if last kill was not a rectangle.
+;; FIXME: The above seems to be incorrect:
+;; + It seems to be the two most recent killed rectangles, and is not
+;; reset upon either a `kill-region' or `kill-line'
+;; + In the following example, the rectangle full of question marks
+;; was killed prior to the rectangle with the string "active".
+;; (#("???e\n??? \n???i\n???," 0 19
+;; (yank-handler
+;; (rectangle--insert-for-yank
+;; ("???e" "??? " "???i" "???,")
+;; t)))
+;; "active " "sert on" " straig" " lines ")
(defvar cua--last-killed-rectangle nil)
-;; List of overlays used to display current rectangle.
-(defvar cua--rectangle-overlays nil)
+(defvar cua--rectangle-overlays nil
+ "List of overlays used to display current rectangle.")
(make-variable-buffer-local 'cua--rectangle-overlays)
(put 'cua--rectangle-overlays 'permanent-local t)
@@ -522,7 +552,7 @@ If command is repeated at same position, delete the rectangle."
;;; Operations on current rectangle
(defun cua--tabify-start (start end)
- ;; Return position where auto-tabify should start (or nil if not required).
+ "Return position where auto-tabify should start (or nil if not required)."
(save-excursion
(save-restriction
(widen)
@@ -538,15 +568,15 @@ If command is repeated at same position, delete the rectangle."
start)))))
(defun cua--rectangle-operation (keep-clear visible undo pad tabify &optional fct post-fct)
- ;; Call FCT for each line of region with 4 parameters:
- ;; Region start, end, left-col, right-col
- ;; Point is at start when FCT is called
- ;; Call fct with (s,e) = whole lines if VISIBLE non-nil.
- ;; Only call fct for visible lines if VISIBLE==t.
- ;; Set undo boundary if UNDO is non-nil.
- ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges)
- ;; Perform auto-tabify after operation if TABIFY is non-nil.
- ;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear.
+ "Call FCT for each line of region with 4 parameters:
+Region start, end, left-col, right-col.
+Point is at start when FCT is called.
+Call fct with (s,e) = whole lines if VISIBLE non-nil.
+Only call fct for visible lines if VISIBLE==t.
+Set undo boundary if UNDO is non-nil.
+Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges)
+Perform auto-tabify after operation if TABIFY is non-nil.
+Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear."
(let* ((inhibit-field-text-motion t)
(start (cua--rectangle-top))
(end (cua--rectangle-bot))
@@ -683,9 +713,9 @@ If command is repeated at same position, delete the rectangle."
(nreverse rect)))
(defun cua--insert-rectangle (rect &optional below paste-column line-count)
- ;; Insert rectangle as insert-rectangle, but don't set mark and exit with
- ;; point at either next to top right or below bottom left corner
- ;; Notice: In overwrite mode, the rectangle is inserted as separate text lines.
+ "Insert rectangle as insert-rectangle, but don't set mark and exit with
+point at either next to top right or below bottom left corner
+Notice: In overwrite mode, the rectangle is inserted as separate text lines."
(if (eq below 'auto)
(setq below (and (bolp)
(or (eolp) (eobp) (= (1+ (point)) (point-max))))))
@@ -735,7 +765,7 @@ If command is repeated at same position, delete the rectangle."
(setq cua--last-killed-rectangle (cons (and kill-ring (car kill-ring)) killed-rectangle))
(if ring
(kill-new (mapconcat
- (function (lambda (row) (concat row "\n")))
+ (lambda (row) (concat row "\n"))
killed-rectangle "")))))
(defun cua--activate-rectangle ()
@@ -1071,7 +1101,7 @@ The text previously in the rectangle is overwritten by the blanks."
(cua--copy-rectangle-to-global-mark t))
(let* ((rect (cua--extract-rectangle))
(text (mapconcat
- (function (lambda (row) (concat row "\n")))
+ (lambda (row) (concat row "\n"))
rect "")))
(setq arg (cua--prefix-arg arg))
(if cua--register
@@ -1150,9 +1180,9 @@ The numbers are formatted according to the FORMAT string."
(list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
(string-to-number
- (read-string "Start value: (0) " nil nil "0")))
+ (read-string (format-prompt "Start value" 0) nil nil "0")))
(string-to-number
- (read-string "Increment: (1) " nil nil "1"))
+ (read-string (format-prompt "Increment" 1) nil nil "1"))
(read-string (concat "Format: (" cua--rectangle-seq-format ") "))))
(if (= (length format) 0)
(setq format cua--rectangle-seq-format)
diff --git a/lisp/emulation/edt-lk201.el b/lisp/emulation/edt-lk201.el
index c922e00f8f6..f7b2c0c93ea 100644
--- a/lisp/emulation/edt-lk201.el
+++ b/lisp/emulation/edt-lk201.el
@@ -1,4 +1,4 @@
-;;; edt-lk201.el --- enhanced EDT keypad mode emulation for LK-201 keyboards
+;;; edt-lk201.el --- enhanced EDT keypad mode emulation for LK-201 keyboards -*- lexical-binding: t -*-
;; Copyright (C) 1986, 1992-1993, 1995, 2001-2020 Free Software
;; Foundation, Inc.
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
index 2fffcbb154a..5dd81fab3b6 100644
--- a/lisp/emulation/edt-mapper.el
+++ b/lisp/emulation/edt-mapper.el
@@ -510,7 +510,8 @@
(if window-system (concat "-" (upcase (symbol-name window-system))))
"-keys")))
(set-visited-file-name
- (read-file-name (format "Save key mapping to file (default %s): " file) nil file)))
+ (read-file-name (format-prompt "Save key mapping to file" file)
+ nil file)))
(save-buffer)
(message "That's it! Press any key to exit")
diff --git a/lisp/emulation/edt-pc.el b/lisp/emulation/edt-pc.el
index aa31d5bc32a..53fc9886b77 100644
--- a/lisp/emulation/edt-pc.el
+++ b/lisp/emulation/edt-pc.el
@@ -1,4 +1,4 @@
-;;; edt-pc.el --- enhanced EDT keypad mode emulation for PC 101 keyboards
+;;; edt-pc.el --- enhanced EDT keypad mode emulation for PC 101 keyboards -*- lexical-binding: t -*-
;; Copyright (C) 1986, 1994-1995, 2001-2020 Free Software Foundation,
;; Inc.
diff --git a/lisp/emulation/edt-vt100.el b/lisp/emulation/edt-vt100.el
index 199212d2227..420d29b6aab 100644
--- a/lisp/emulation/edt-vt100.el
+++ b/lisp/emulation/edt-vt100.el
@@ -1,4 +1,4 @@
-;;; edt-vt100.el --- enhanced EDT keypad mode emulation for VT series terminals
+;;; edt-vt100.el --- enhanced EDT keypad mode emulation for VT series terminals -*- lexical-binding: t -*-
;; Copyright (C) 1986, 1992-1993, 1995, 2002-2020 Free Software
;; Foundation, Inc.
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index 8dc18ebc85e..e70b44658d5 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -178,10 +178,8 @@
(defvar edt-user-global-map)
(defvar rect-start-point)
-;;;
-;;; Version Information
-;;;
(defconst edt-version "4.0" "EDT Emulation version number.")
+(make-obsolete-variable 'edt-version nil "28.1")
;;;
;;; User Configurable Variables
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index ca7fcaf2d91..dd7648c2b77 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -466,24 +466,7 @@
(assoc major-mode viper-emacs-state-modifier-alist)))
(cdr
(assoc major-mode viper-emacs-state-modifier-alist))
- viper-empty-keymap))
- ))
-
- ;; This var is not local in Emacs, so we make it local. It must be local
- ;; because although the stack of minor modes can be the same for all buffers,
- ;; the associated *keymaps* can be different. In Viper,
- ;; viper-vi-local-user-map, viper-insert-local-user-map, and others can have
- ;; different keymaps for different buffers. Also, the keymaps associated
- ;; with viper-vi/insert-state-modifier-minor-mode can be different.
- ;; ***This is needed only in case emulation-mode-map-alists is not defined.
- ;; In emacs with emulation-mode-map-alists, nothing needs to be done
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (set (make-local-variable 'minor-mode-map-alist)
- (viper-append-filter-alist
- (append viper--intercept-key-maps viper--key-maps)
- minor-mode-map-alist)))
- )
+ viper-empty-keymap)))))
@@ -711,7 +694,7 @@
ARG is used as the prefix value for the executed command. If
EVENTS is a list of events, which become the beginning of the command."
(interactive "P")
- (if (viper= (viper-last-command-char) ?\\)
+ (if (viper= last-command-event ?\\)
(message "Switched to EMACS state for the next command..."))
(viper-escape-to-state arg events 'emacs-state))
@@ -893,16 +876,7 @@ LOAD-FILE is the name of the file where the specific minor mode is defined.
Suffixes such as .el or .elc should be stripped."
(interactive "sEnter name of the load file: ")
-
- (eval-after-load load-file '(viper-normalize-minor-mode-map-alist))
-
- ;; Change the default for minor-mode-map-alist each time a harnessed minor
- ;; mode adds its own keymap to the a-list.
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (eval-after-load
- load-file '(setq-default minor-mode-map-alist minor-mode-map-alist)))
- )
+ (eval-after-load load-file '(viper-normalize-minor-mode-map-alist)))
(defun viper-ESC (arg)
@@ -1175,7 +1149,7 @@ as a Meta key and any number of multiple escapes are allowed."
"Begin numeric argument for the next command."
(interactive "P")
(viper-prefix-arg-value
- (viper-last-command-char) (if (consp arg) (cdr arg) nil)))
+ last-command-event (if (consp arg) (cdr arg) nil)))
(defun viper-command-argument (arg)
"Accept a motion command as an argument."
@@ -1183,7 +1157,7 @@ as a Meta key and any number of multiple escapes are allowed."
(let ((viper-intermediate-command 'viper-command-argument))
(condition-case nil
(viper-prefix-arg-com
- (viper-last-command-char)
+ last-command-event
(cond ((null arg) nil)
((consp arg) (car arg))
((integerp arg) arg)
@@ -1590,7 +1564,7 @@ invokes the command before that, etc."
;; Hook used in viper-undo
(defun viper-after-change-undo-hook (beg end _len)
- (if (and (boundp 'undo-in-progress) undo-in-progress)
+ (if undo-in-progress
(setq undo-beg-posn beg
undo-end-posn (or end beg))
;; some other hooks may be changing various text properties in
@@ -1624,9 +1598,9 @@ invokes the command before that, etc."
(pos-visible-in-window-p before-undo-pt))
(progn
(push-mark (point-marker) t)
- (viper-sit-for-short 300)
+ (sit-for 0.3)
(goto-char undo-end-posn)
- (viper-sit-for-short 300)
+ (sit-for 0.3)
(if (pos-visible-in-window-p undo-beg-posn)
(goto-char before-undo-pt)
(goto-char undo-beg-posn)))
@@ -1912,15 +1886,11 @@ Undo previous insertion and inserts new."
(or unread-command-events
executing-kbd-macro
(sit-for 840))
- (if (fboundp 'minibuffer-prompt-end)
- (delete-region (minibuffer-prompt-end) (point-max))
- (erase-buffer))
+ (delete-region (minibuffer-prompt-end) (point-max))
(insert viper-initial)))
(defsubst viper-minibuffer-real-start ()
- (if (fboundp 'minibuffer-prompt-end)
- (minibuffer-prompt-end)
- (point-min)))
+ (minibuffer-prompt-end))
(defun viper-minibuffer-post-command-hook()
(when (active-minibuffer-window)
@@ -1934,7 +1904,7 @@ Undo previous insertion and inserts new."
"Exit minibuffer Viper way."
(interactive)
(let (command)
- (setq command (local-key-binding (char-to-string (viper-last-command-char))))
+ (setq command (local-key-binding (char-to-string last-command-event)))
(run-hooks 'viper-minibuffer-exit-hook)
(if command
(command-execute command)
@@ -2909,7 +2879,7 @@ If point is on a widget or a button, simulate clicking on that widget/button."
(and (consp widget)
(get (widget-type widget) 'widget-type))))
(widget-button-press (point))
- (if (and (fboundp 'button-at) (fboundp 'push-button) (button-at (point)))
+ (if (button-at (point))
(push-button)
;; not a widget or a button
(save-excursion
@@ -4721,8 +4691,7 @@ Please, specify your level now: "))
(interactive "cViper register to point: ")
(let ((val (get-register char)))
(cond
- ((and (fboundp 'frame-configuration-p)
- (frame-configuration-p val))
+ ((frame-configuration-p val)
(set-frame-configuration val))
((window-configuration-p val)
(set-window-configuration val))
@@ -4765,8 +4734,7 @@ Please, specify your level now: "))
(viper-color-display-p (if (viper-window-display-p)
(viper-color-display-p)
'non-x))
- (viper-frame-parameters (if (fboundp 'frame-parameters)
- (frame-parameters (selected-frame))))
+ (viper-frame-parameters (frame-parameters (selected-frame)))
(viper-minibuffer-emacs-face (if (viper-has-face-support-p)
(facep
viper-minibuffer-emacs-face)
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 511c68f24a7..6c4afe519f2 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -922,6 +922,8 @@ Should be set in `viper-custom-file-name'."
"Hooks run just after loading Viper."
:type 'hook
:group 'viper-hooks)
+(make-obsolete-variable 'viper-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defun viper-restore-cursor-type ()
(condition-case nil
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index 1b149b12e41..d76cf71b314 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -184,7 +184,7 @@ In insert mode, this key also functions as Meta."
:type 'string
:group 'viper)
-(defconst viper-ESC-key [escape]
+(defconst viper-ESC-key (kbd "ESC")
"Key used to ESC.")
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
index 294705f7c3a..928a3ef00ee 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -66,20 +66,13 @@ or a triple-click."
;; time interval in millisecond within which successive clicks are
;; considered related
(defcustom viper-multiclick-timeout (if (viper-window-display-p)
- (if (featurep 'xemacs)
- mouse-track-multi-click-time
- double-click-time)
+ double-click-time
500)
"Time interval in millisecond within which successive mouse clicks are
considered related."
:type 'integer
:group 'viper-mouse)
-;; current event click count; XEmacs only
-(defvar viper-current-click-count 0)
-;; time stamp of the last click event; XEmacs only
-(defvar viper-last-click-event-timestamp 0)
-
;; Local variable used to toggle wraparound search on click.
(viper-deflocalvar viper-mouse-click-search-noerror t)
@@ -105,7 +98,7 @@ considered related."
;;; Code
(defsubst viper-multiclick-p ()
- (not (viper-sit-for-short viper-multiclick-timeout t)))
+ (not (sit-for (/ viper-multiclick-timeout 1000.0) t)))
;; Returns window where click occurs
(defun viper-mouse-click-window (click)
@@ -279,11 +272,9 @@ See `viper-surrounding-word' for the definition of a word in this case."
(setq interrupting-event (read-event))
(viper-mouse-event-p last-input-event)))
(progn ; interrupted wait
- (setq viper-global-prefix-argument arg)
- ;; count this click for XEmacs
- (viper-event-click-count click))
+ (setq viper-global-prefix-argument arg))
;; uninterrupted wait or the interrupting event wasn't a mouse event
- (setq click-count (viper-event-click-count click))
+ (setq click-count (event-click-count click))
(if (> click-count 1)
(setq arg viper-global-prefix-argument
viper-global-prefix-argument nil))
@@ -300,33 +291,8 @@ See `viper-surrounding-word' for the definition of a word in this case."
(string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
(prin1-to-string (viper-event-key event)))))
-;; XEmacs has no double-click events. So, we must simulate.
-;; So, we have to simulate event-click-count.
-(defun viper-event-click-count (click)
- (if (featurep 'xemacs) (viper-event-click-count-xemacs click)
- (event-click-count click)))
-
-(when (featurep 'xemacs)
-
- ;; kind of semaphore for updating viper-current-click-count
- (defvar viper-counting-clicks-p nil)
-
- (defun viper-event-click-count-xemacs (click)
- (let ((time-delta (- (event-timestamp click)
- viper-last-click-event-timestamp))
- inhibit-quit)
- (while viper-counting-clicks-p
- (ignore))
- (setq viper-counting-clicks-p t)
- (if (> time-delta viper-multiclick-timeout)
- (setq viper-current-click-count 0))
- (discard-input)
- (setq viper-current-click-count (1+ viper-current-click-count)
- viper-last-click-event-timestamp (event-timestamp click))
- (setq viper-counting-clicks-p nil)
- (if (viper-sit-for-short viper-multiclick-timeout t)
- viper-current-click-count
- 0))))
+(define-obsolete-function-alias 'viper-event-click-count
+ 'event-click-count "28.1")
(declare-function viper-forward-word "viper-cmd" (arg))
(declare-function viper-adjust-window "viper-cmd" ())
@@ -364,11 +330,9 @@ this command.
(setq viper-global-prefix-argument (or viper-global-prefix-argument
arg)
;; remember command that was before the multiclick
- this-command last-command)
- ;; make sure we counted this event---needed for XEmacs only
- (viper-event-click-count click))
+ this-command last-command))
;; uninterrupted wait
- (setq click-count (viper-event-click-count click))
+ (setq click-count (event-click-count click))
(setq click-word (viper-mouse-click-get-word click nil click-count))
(if (> click-count 1)
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index ebad850e6b7..83e45e1cd0c 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -205,6 +205,7 @@ Otherwise return the normal value."
;; incorrect. However, this gives correct result in our cases, since we are
;; testing for sufficiently high Emacs versions.
(defun viper-check-version (op major minor &optional type-of-emacs)
+ (declare (obsolete nil "28.1"))
(if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
(and (cond ((eq type-of-emacs 'xemacs) (featurep 'xemacs))
((eq type-of-emacs 'emacs) (featurep 'emacs))
@@ -785,14 +786,11 @@ Otherwise return the normal value."
(defun viper-check-minibuffer-overlay ()
(if (overlayp viper-minibuffer-overlay)
(move-overlay
- viper-minibuffer-overlay
- (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
- (1+ (buffer-size)))
+ viper-minibuffer-overlay (minibuffer-prompt-end) (1+ (buffer-size)))
(setq viper-minibuffer-overlay
;; make overlay open-ended
(make-overlay
- (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
- (1+ (buffer-size))
+ (minibuffer-prompt-end) (1+ (buffer-size))
(current-buffer) nil 'rear-advance))))
@@ -807,9 +805,8 @@ Otherwise return the normal value."
(define-obsolete-function-alias 'viper-abbreviate-file-name
'abbreviate-file-name "27.1")
-;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
-;; in sit-for, so this function smooths out the differences.
(defsubst viper-sit-for-short (val &optional nodisp)
+ (declare (obsolete nil "28.1"))
(sit-for (/ val 1000.0) nodisp))
;; EVENT may be a single event of a sequence of events
@@ -867,11 +864,10 @@ Otherwise return the normal value."
;; Uses different timeouts for ESC-sequences and others
(defun viper-fast-keysequence-p ()
- (not (viper-sit-for-short
- (if (viper-ESC-event-p last-input-event)
- (viper-ESC-keyseq-timeout)
- viper-fast-keyseq-timeout)
- t)))
+ (not (sit-for (/ (if (viper-ESC-event-p last-input-event)
+ (viper-ESC-keyseq-timeout)
+ viper-fast-keyseq-timeout) 1000.0)
+ t)))
(define-obsolete-function-alias 'viper-read-event-convert-to-char
'read-event "27.1")
@@ -919,6 +915,7 @@ Otherwise return the normal value."
basis)))
(defun viper-last-command-char ()
+ (declare (obsolete nil "28.1"))
last-command-event)
(defun viper-key-to-emacs-key (key)
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 492c31bde74..59ca6298eb9 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -695,9 +695,6 @@ It also can't undo some Viper settings."
'mark-even-if-inactive viper-saved-non-viper-variables))
;; Ideally, we would like to be able to de-localize local variables
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (viper-delocalize-var 'minor-mode-map-alist))
(viper-delocalize-var 'require-final-newline)
;; deactivate all advices done by Viper.
@@ -705,11 +702,9 @@ It also can't undo some Viper settings."
(setq viper-mode nil)
- (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (setq emulation-mode-map-alists
- (delq 'viper--intercept-key-maps
- (delq 'viper--key-maps emulation-mode-map-alists))
- ))
+ (setq emulation-mode-map-alists
+ (delq 'viper--intercept-key-maps
+ (delq 'viper--key-maps emulation-mode-map-alists)))
(viper-delocalize-var 'viper-vi-minibuffer-minor-mode)
(viper-delocalize-var 'viper-insert-minibuffer-minor-mode)
@@ -943,13 +938,11 @@ Two differences:
(setq viper-vi-state-cursor-color color-name)))
- (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- ;; needs to be as early as possible
- (add-to-ordered-list
- 'emulation-mode-map-alists 'viper--intercept-key-maps 100)
- ;; needs to be after cua-mode
- (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500)
- )
+ ;; needs to be as early as possible
+ (add-to-ordered-list
+ 'emulation-mode-map-alists 'viper--intercept-key-maps 100)
+ ;; needs to be after cua-mode
+ (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500)
;; Emacs shell, ange-ftp, and comint-based modes
(add-hook 'comint-mode-hook #'viper-comint-mode-hook) ; comint
@@ -1062,10 +1055,7 @@ This may be needed if the previous `:map' command terminated abnormally."
(viper--advice-add 'add-minor-mode :after
(lambda (&rest _)
"Run viper-normalize-minor-mode-map-alist after adding a minor mode."
- (viper-normalize-minor-mode-map-alist)
- (unless
- (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
- (setq-default minor-mode-map-alist minor-mode-map-alist))))
+ (viper-normalize-minor-mode-map-alist)))
;; catch frame switching event
(if (viper-window-display-p)
@@ -1221,7 +1211,6 @@ These two lines must come in the order given."))
(viper-harness-minor-mode "outline")
(viper-harness-minor-mode "allout")
(viper-harness-minor-mode "xref")
- (viper-harness-minor-mode "lmenu")
(viper-harness-minor-mode "vc")
(viper-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX, which
(viper-harness-minor-mode "latex") ; sits in one of these two files
@@ -1254,12 +1243,7 @@ These two lines must come in the order given."))
;; Without setting the default, new buffers that come up in emacs mode have
;; minor-mode-map-alist = nil, unless we call viper-change-state-*
(when (eq viper-current-state 'emacs-state)
- (viper-change-state-to-emacs)
- (unless
- (and (fboundp 'add-to-ordered-list)
- (boundp 'emulation-mode-map-alists))
- (setq-default minor-mode-map-alist minor-mode-map-alist))
- )
+ (viper-change-state-to-emacs))
(if (this-major-mode-requires-vi-state major-mode)
(viper-mode))
diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el
index f601d426566..4ff1ba33941 100644
--- a/lisp/epa-dired.el
+++ b/lisp/epa-dired.el
@@ -1,4 +1,5 @@
;;; epa-dired.el --- the EasyPG Assistant, dired extension -*- lexical-binding: t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -29,48 +30,40 @@
(defun epa-dired-do-decrypt ()
"Decrypt marked files."
(interactive)
- (let ((file-list (dired-get-marked-files)))
- (while file-list
- (epa-decrypt-file (expand-file-name (car file-list)))
- (setq file-list (cdr file-list)))
- (revert-buffer)))
+ (dolist (file (dired-get-marked-files))
+ (epa-decrypt-file (expand-file-name file)))
+ (revert-buffer))
;;;###autoload
(defun epa-dired-do-verify ()
"Verify marked files."
(interactive)
- (let ((file-list (dired-get-marked-files)))
- (while file-list
- (epa-verify-file (expand-file-name (car file-list)))
- (setq file-list (cdr file-list)))))
+ (dolist (file (dired-get-marked-files))
+ (epa-verify-file (expand-file-name file))))
;;;###autoload
(defun epa-dired-do-sign ()
"Sign marked files."
(interactive)
- (let ((file-list (dired-get-marked-files)))
- (while file-list
- (epa-sign-file
- (expand-file-name (car file-list))
- (epa-select-keys (epg-make-context) "Select keys for signing.
+ (dolist (file (dired-get-marked-files))
+ (epa-sign-file
+ (expand-file-name file)
+ (epa-select-keys (epg-make-context) "Select keys for signing.
If no one is selected, default secret key is used. "
- nil t)
- (y-or-n-p "Make a detached signature? "))
- (setq file-list (cdr file-list)))
- (revert-buffer)))
+ nil t)
+ (y-or-n-p "Make a detached signature? ")))
+ (revert-buffer))
;;;###autoload
(defun epa-dired-do-encrypt ()
"Encrypt marked files."
(interactive)
- (let ((file-list (dired-get-marked-files)))
- (while file-list
- (epa-encrypt-file
- (expand-file-name (car file-list))
- (epa-select-keys (epg-make-context) "Select recipients for encryption.
-If no one is selected, symmetric encryption will be performed. "))
- (setq file-list (cdr file-list)))
- (revert-buffer)))
+ (dolist (file (dired-get-marked-files))
+ (epa-encrypt-file
+ (expand-file-name file)
+ (epa-select-keys (epg-make-context) "Select recipients for encryption.
+If no one is selected, symmetric encryption will be performed. ")))
+ (revert-buffer))
(provide 'epa-dired)
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index dedf20b0d77..7fd41784746 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -1,4 +1,5 @@
;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*- lexical-binding: t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -21,9 +22,13 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Dependencies
(require 'epa)
(require 'epa-hook)
+(eval-when-compile (require 'subr-x))
+
+;;; Options
(defcustom epa-file-cache-passphrase-for-symmetric-encryption nil
"If non-nil, cache passphrase for symmetric encryption.
@@ -40,26 +45,18 @@ Note that this option has no effect if you use GnuPG 2.0."
(defcustom epa-file-select-keys nil
"Control whether or not to pop up the key selection dialog.
-If t, always asks user to select recipients.
+If t, always ask user to select recipients.
If nil, query user only when `epa-file-encrypt-to' is not set.
-If neither t nor nil, doesn't ask user. In this case, symmetric
+If neither t nor nil, don't ask user. In this case, symmetric
encryption is used."
:type '(choice (const :tag "Ask always" t)
(const :tag "Ask when recipients are not set" nil)
(const :tag "Don't ask" silent))
:group 'epa-file)
-(defvar epa-file-passphrase-alist nil)
-
-(eval-and-compile
- (if (fboundp 'encode-coding-string)
- (defalias 'epa-file--encode-coding-string 'encode-coding-string)
- (defalias 'epa-file--encode-coding-string 'identity)))
+;;; Other
-(eval-and-compile
- (if (fboundp 'decode-coding-string)
- (defalias 'epa-file--decode-coding-string 'decode-coding-string)
- (defalias 'epa-file--decode-coding-string 'identity)))
+(defvar epa-file-passphrase-alist nil)
(defun epa-file-passphrase-callback-function (context key-id file)
(if (and epa-file-cache-passphrase-for-symmetric-encryption
@@ -71,8 +68,8 @@ encryption is used."
(or (copy-sequence (cdr entry))
(progn
(unless entry
- (setq entry (list file)
- epa-file-passphrase-alist
+ (setq entry (list file))
+ (setq epa-file-passphrase-alist
(cons entry
epa-file-passphrase-alist)))
(setq passphrase (epa-passphrase-callback-function context
@@ -82,6 +79,8 @@ encryption is used."
passphrase))))
(epa-passphrase-callback-function context key-id file)))
+;;; File Handler
+
(defvar epa-inhibit nil
"Non-nil means don't try to decrypt .gpg files when operating on them.")
@@ -117,8 +116,17 @@ encryption is used."
(let ((error epa-file-error))
(save-window-excursion
(kill-buffer))
- (signal 'file-missing
- (cons "Opening input file" (cdr error)))))
+ (if (nth 3 error)
+ (user-error "Wrong passphrase: %s" (nth 3 error))
+ (signal 'file-missing
+ (cons "Opening input file" (cdr error))))))
+
+(defun epa--wrong-password-p (context)
+ (let ((error-string (epg-context-error-output context)))
+ (and (string-match
+ "decryption failed: \\(Bad session key\\|No secret key\\)"
+ error-string)
+ (match-string 1 error-string))))
(defvar last-coding-system-used)
(defun epa-file-insert-file-contents (file &optional visit beg end replace)
@@ -161,15 +169,28 @@ encryption is used."
(nth 3 error)))
(let ((exists (file-exists-p local-file)))
(when exists
- ;; Hack to prevent find-file from opening empty buffer
- ;; when decryption failed (bug#6568). See the place
- ;; where `find-file-not-found-functions' are called in
- ;; `find-file-noselect-1'.
- (setq-local epa-file-error error)
- (add-hook 'find-file-not-found-functions
- 'epa-file--find-file-not-found-function
- nil t)
- (epa-display-error context))
+ (if-let ((wrong-password (epa--wrong-password-p context)))
+ ;; Don't display the *error* buffer if we just
+ ;; have a wrong password; let the later error
+ ;; handler notify the user.
+ (setq error (append error (list wrong-password)))
+ (epa-display-error context))
+ ;; When the .gpg file isn't an encrypted file (e.g.,
+ ;; it's a keyring.gpg file instead), then gpg will
+ ;; say "Unexpected exit" as the error message. In
+ ;; that case, just display the bytes.
+ (if (equal (caddr error) "Unexpected; Exit")
+ (setq string (with-temp-buffer
+ (insert-file-contents-literally local-file)
+ (buffer-string)))
+ ;; Hack to prevent find-file from opening empty buffer
+ ;; when decryption failed (bug#6568). See the place
+ ;; where `find-file-not-found-functions' are called in
+ ;; `find-file-noselect-1'.
+ (setq-local epa-file-error error)
+ (add-hook 'find-file-not-found-functions
+ 'epa-file--find-file-not-found-function
+ nil t)))
(signal (if exists 'file-error 'file-missing)
(cons "Opening input file" (cdr error))))))
(set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)!
@@ -236,11 +257,7 @@ encryption is used."
(setq file (expand-file-name file))
(let* ((coding-system (or coding-system-for-write
(if (fboundp 'select-safe-coding-system)
- ;; This is needed since Emacs 22 has
- ;; no-conversion setting for *.gpg in
- ;; `auto-coding-alist'.
- (let ((buffer-file-name
- (file-name-sans-extension file)))
+ (let ((buffer-file-name file))
(select-safe-coding-system
(point-min) (point-max)))
buffer-file-coding-system)))
@@ -266,7 +283,7 @@ encryption is used."
(epg-encrypt-string
context
(if (stringp start)
- (epa-file--encode-coding-string start coding-system)
+ (encode-coding-string start coding-system)
(unless start
(setq start (point-min)
end (point-max)))
@@ -280,8 +297,8 @@ encryption is used."
;; decrypted contents.
(format-encode-buffer (with-current-buffer buffer
buffer-file-format))
- (epa-file--encode-coding-string (buffer-string)
- coding-system)))
+ (encode-coding-string (buffer-string)
+ coding-system)))
(if (or (eq epa-file-select-keys t)
(and (null epa-file-select-keys)
(not (local-variable-p 'epa-file-encrypt-to
@@ -317,6 +334,8 @@ If no one is selected, symmetric encryption will be performed. "
(message "Wrote %s" buffer-file-name))))
(put 'write-region 'epa-file 'epa-file-write-region)
+;;; Commands
+
(defun epa-file-select-keys ()
"Select recipients for encryption."
(interactive)
diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el
index d424e7a9faf..6f12f8a6bfa 100644
--- a/lisp/epa-hook.el
+++ b/lisp/epa-hook.el
@@ -1,4 +1,5 @@
;;; epa-hook.el --- preloaded code to enable epa-file.el -*- lexical-binding: t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -35,10 +36,10 @@
(defcustom epa-file-name-regexp (purecopy "\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'")
"Regexp which matches filenames to be encrypted with GnuPG.
-If you set this outside Custom while epa-file is already enabled, you
-have to call `epa-file-name-regexp-update' after setting it to
-properly update file-name-handler-alist. Setting this through Custom
-does that automatically."
+If you set this outside Custom while epa-file is already enabled,
+you have to call `epa-file-name-regexp-update' after setting it
+to properly update `file-name-handler-alist'. Setting this
+through Custom does that automatically."
:type 'regexp
:group 'epa-file
:set 'epa-file--file-name-regexp-set)
@@ -72,6 +73,9 @@ May either be a string or a list of strings.")
(list epa-file-name-regexp nil 'epa-file))
(defun epa-file-name-regexp-update ()
+ "Update `file-name-handler-alist' after configuring outside Custom.
+After setting `epa-file-name-regexp-update' outside the Custom
+interface, update `file-name-handler-alist'."
(interactive)
(unless (equal (car epa-file-handler) epa-file-name-regexp)
(setcar epa-file-handler epa-file-name-regexp)))
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 63475256ca8..dd171ab6474 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -1,4 +1,5 @@
;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*- lexical-binding: t -*-
+
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -21,10 +22,13 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Dependencies
(require 'epa)
(require 'mail-utils)
+;;; Local Mode
+
(defvar epa-mail-mode-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap "\C-c\C-ed" 'epa-mail-decrypt)
@@ -45,11 +49,20 @@
(defvar epa-mail-mode-on-hook nil)
(defvar epa-mail-mode-off-hook nil)
+(defcustom epa-mail-offer-skip t
+ "If non-nil, when a recipient has no key, ask whether to skip it.
+Otherwise, signal an error."
+ :type 'boolean
+ :version "28.1"
+ :group 'epa-mail)
+
;;;###autoload
(define-minor-mode epa-mail-mode
"A minor-mode for composing encrypted/clearsigned mails."
nil " epa-mail" epa-mail-mode-map)
+;;; Utilities
+
(defun epa-mail--find-usable-key (keys usage)
"Find a usable key from KEYS for USAGE.
USAGE would be `sign' or `encrypt'."
@@ -64,6 +77,8 @@ USAGE would be `sign' or `encrypt'."
(setq pointer (cdr pointer))))
(setq keys (cdr keys)))))
+;;; Commands
+
;;;###autoload
(defun epa-mail-decrypt ()
"Decrypt OpenPGP armors in the current buffer.
@@ -210,10 +225,12 @@ If no one is selected, symmetric encryption will be performed. "
recipient))
'encrypt)))
(unless (or recipient-key
- (y-or-n-p
- (format
- "No public key for %s; skip it? "
- recipient)))
+ (and epa-mail-offer-skip
+ (y-or-n-p
+ (format
+ "No public key for %s; skip it? "
+ recipient)))
+ )
(error "No public key for %s" recipient))
(if recipient-key (list recipient-key))))
default-recipients)))))
@@ -226,6 +243,11 @@ If no one is selected, symmetric encryption will be performed. "
(setq epa-last-coding-system-specified
(or coding-system-for-write
(select-safe-coding-system (point) (point-max)))))
+
+ ;; Insert contents of requested attachments, if any.
+ (when (and (eq major-mode 'mail-mode) mail-encode-mml)
+ (mml-to-mime)
+ (setq mail-encode-mml nil))
;; Don't let some read-only text stop us from encrypting.
(let ((inhibit-read-only t))
@@ -241,6 +263,8 @@ The buffer is expected to contain a mail message."
(interactive)
(epa-import-armor-in-region (point-min) (point-max)))
+;;; Global Mode
+
;;;###autoload
(define-minor-mode epa-global-mail-mode
"Minor mode to hook EasyPG into Mail mode."
diff --git a/lisp/epa.el b/lisp/epa.el
index 47c177e6cd5..25e055c201f 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -21,13 +21,15 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Dependencies
(require 'epg)
(require 'font-lock)
-(require 'widget)
-(eval-when-compile (require 'wid-edit))
+(eval-when-compile (require 'subr-x))
(require 'derived)
+;;; Options
+
(defgroup epa nil
"The EasyPG Assistant"
:version "23.1"
@@ -56,11 +58,6 @@ If neither t nor nil, ask user for confirmation."
:type 'integer
:group 'epa)
-(defgroup epa-faces nil
- "Faces for epa-mode."
- :version "23.1"
- :group 'epa)
-
(defcustom epa-mail-aliases nil
"Alist of aliases of email addresses that stand for encryption keys.
Each element is a list of email addresses (ALIAS EXPANSIONS...).
@@ -76,6 +73,13 @@ The command `epa-mail-encrypt' uses this."
:group 'epa
:version "24.4")
+;;; Faces
+
+(defgroup epa-faces nil
+ "Faces for epa-mode."
+ :version "23.1"
+ :group 'epa)
+
(defface epa-validity-high
'((default :weight bold)
(((class color) (background dark)) :foreground "PaleTurquoise"))
@@ -117,13 +121,15 @@ The command `epa-mail-encrypt' uses this."
'((default :weight bold)
(((class color) (background dark)) :foreground "PaleTurquoise"))
"Face for the name of the attribute field."
- :group 'epa)
+ :version "28.1"
+ :group 'epa-faces)
(defface epa-field-body
'((default :slant italic)
(((class color) (background dark)) :foreground "turquoise"))
"Face for the body of the attribute field."
- :group 'epa)
+ :version "28.1"
+ :group 'epa-faces)
(defcustom epa-validity-face-alist
'((unknown . epa-validity-disabled)
@@ -138,16 +144,11 @@ The command `epa-mail-encrypt' uses this."
(full . epa-validity-high)
(ultimate . epa-validity-high))
"An alist mapping validity values to faces."
+ :version "28.1"
:type '(repeat (cons symbol face))
- :group 'epa)
+ :group 'epa-faces)
-(defvar epa-font-lock-keywords
- '(("^\\*"
- (0 'epa-mark))
- ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$"
- (1 'epa-field-name)
- (2 'epa-field-body)))
- "Default expressions to addon in epa-mode.")
+;;; Variables
(defconst epa-pubkey-algorithm-letter-alist
'((1 . ?R)
@@ -185,6 +186,9 @@ You should bind this variable with `let', but do not set it globally.")
(defvar epa-key-list-mode-map
(let ((keymap (make-sparse-keymap))
(menu-map (make-sparse-keymap)))
+ (define-key keymap "\C-m" 'epa-show-key)
+ (define-key keymap [?\t] 'forward-button)
+ (define-key keymap [backtab] 'backward-button)
(define-key keymap "m" 'epa-mark-key)
(define-key keymap "u" 'epa-unmark-key)
(define-key keymap "d" 'epa-decrypt-file)
@@ -245,53 +249,43 @@ You should bind this variable with `let', but do not set it globally.")
(defvar epa-exit-buffer-function #'quit-window)
-(define-widget 'epa-key 'push-button
- "Button for representing an epg-key object."
- :format "%[%v%]"
- :button-face-get 'epa--key-widget-button-face-get
- :value-create 'epa--key-widget-value-create
- :action 'epa--key-widget-action
- :help-echo 'epa--key-widget-help-echo)
-
-(defun epa--key-widget-action (widget &optional _event)
- (save-selected-window
- (epa--show-key (widget-get widget :value))))
-
-(defun epa--key-widget-value-create (widget)
- (let* ((key (widget-get widget :value))
- (primary-sub-key (car (epg-key-sub-key-list key)))
- (primary-user-id (car (epg-key-user-id-list key))))
- (insert (format "%c "
- (if (epg-sub-key-validity primary-sub-key)
- (car (rassq (epg-sub-key-validity primary-sub-key)
- epg-key-validity-alist))
- ? ))
- (epg-sub-key-id primary-sub-key)
- " "
- (if primary-user-id
- (if (stringp (epg-user-id-string primary-user-id))
- (epg-user-id-string primary-user-id)
- (epg-decode-dn (epg-user-id-string primary-user-id)))
- ""))))
-
-(defun epa--key-widget-button-face-get (widget)
- (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
- (widget-get widget :value))))))
- (if validity
- (cdr (assq validity epa-validity-face-alist))
- 'default)))
-
-(defun epa--key-widget-help-echo (widget)
- (format "Show %s"
- (epg-sub-key-id (car (epg-key-sub-key-list
- (widget-get widget :value))))))
+(defun epa--button-key-text (key)
+ (let ((primary-sub-key (car (epg-key-sub-key-list key)))
+ (primary-user-id (car (epg-key-user-id-list key)))
+ (validity (epg-sub-key-validity (car (epg-key-sub-key-list key)))))
+ (propertize
+ (concat
+ (propertize
+ (format "%c "
+ (if (epg-sub-key-validity primary-sub-key)
+ (car (rassq (epg-sub-key-validity primary-sub-key)
+ epg-key-validity-alist))
+ ? ))
+ 'help-echo (format "Validity: %s"
+ (epg-sub-key-validity primary-sub-key)))
+ (propertize
+ (concat
+ (epg-sub-key-id primary-sub-key)
+ " "
+ (if primary-user-id
+ (if (stringp (epg-user-id-string primary-user-id))
+ (epg-user-id-string primary-user-id)
+ (epg-decode-dn (epg-user-id-string primary-user-id)))
+ ""))
+ 'help-echo (format "Show %s"
+ (epg-sub-key-id (car (epg-key-sub-key-list key))))))
+ 'face
+ (if validity
+ (cdr (assq validity epa-validity-face-alist))
+ 'default))))
+
+;;; Modes
(define-derived-mode epa-key-list-mode special-mode "EPA Keys"
"Major mode for `epa-list-keys'."
(buffer-disable-undo)
(setq truncate-lines t
buffer-read-only t)
- (setq-local font-lock-defaults '(epa-font-lock-keywords t))
(make-local-variable 'epa-exit-buffer-function)
(setq-local revert-buffer-function #'epa--key-list-revert-buffer))
@@ -300,7 +294,6 @@ You should bind this variable with `let', but do not set it globally.")
(buffer-disable-undo)
(setq truncate-lines t
buffer-read-only t)
- (setq-local font-lock-defaults '(epa-font-lock-keywords t))
(make-local-variable 'epa-exit-buffer-function))
(define-derived-mode epa-info-mode special-mode "EPA Info"
@@ -309,6 +302,9 @@ You should bind this variable with `let', but do not set it globally.")
(setq truncate-lines t
buffer-read-only t))
+;;; Commands
+;;;; Marking
+
(defun epa-mark-key (&optional arg)
"Mark a key on the current line.
If ARG is non-nil, unmark the key."
@@ -331,37 +327,27 @@ If ARG is non-nil, mark the key."
(interactive "P")
(epa-mark-key (not arg)))
+;;;; Quitting
+
(defun epa-exit-buffer ()
- "Exit the current buffer.
-`epa-exit-buffer-function' is called if it is set."
+ "Exit the current buffer using `epa-exit-buffer-function'."
(interactive)
(funcall epa-exit-buffer-function))
-(defun epa--insert-keys (keys)
- (save-excursion
- (save-restriction
- (narrow-to-region (point) (point))
- (let (point)
- (while keys
- (setq point (point))
- (insert " ")
- (add-text-properties point (point)
- (list 'epa-key (car keys)
- 'front-sticky nil
- 'rear-nonsticky t
- 'start-open t
- 'end-open t))
- (widget-create 'epa-key :value (car keys))
- (insert "\n")
- (setq keys (cdr keys))))
- (add-text-properties (point-min) (point-max)
- (list 'epa-list-keys t
- 'front-sticky nil
- 'rear-nonsticky t
- 'start-open t
- 'end-open t)))))
+;;;; Listing and Selecting
-(defun epa--list-keys (name secret)
+(defun epa--insert-keys (keys)
+ (dolist (key keys)
+ (insert
+ (propertize
+ (concat " " (epa--button-key-text key))
+ 'epa-key key))
+ (insert "\n")))
+
+(defun epa--list-keys (name secret &optional doc)
+ "NAME specifies which key to list.
+SECRET says list data on the secret key (default, the public key).
+DOC is documentation text to insert at the start."
(unless (and epa-keys-buffer
(buffer-live-p epa-keys-buffer))
(setq epa-keys-buffer (generate-new-buffer "*Keys*")))
@@ -371,16 +357,29 @@ If ARG is non-nil, mark the key."
buffer-read-only
(point (point-min))
(context (epg-make-context epa-protocol)))
+
+ ;; Find the end of the documentation text at the start.
+ ;; Set POINT to where it ends, or nil if ends at eob.
(unless (get-text-property point 'epa-list-keys)
(setq point (next-single-property-change point 'epa-list-keys)))
+
+ ;; If caller specified documentation text for that, replace the old
+ ;; documentation text (if any) with what was specified.
+ ;; Otherwise, preserve whatever intro text is present.
+ (when doc
+ (if (or point (not (eobp)))
+ (delete-region (point-min) point))
+ (insert doc)
+ (setq point (point)))
+
+ ;; Now delete the key description text, if any.
(when point
(delete-region point
(or (next-single-property-change point 'epa-list-keys)
(point-max)))
(goto-char point))
- (epa--insert-keys (epg-list-keys context name secret))
- (widget-setup)
- (set-keymap-parent (current-local-map) widget-keymap))
+
+ (epa--insert-keys (epg-list-keys context name secret)))
(make-local-variable 'epa-list-keys-arguments)
(setq epa-list-keys-arguments (list name secret))
(goto-char (point-min))
@@ -396,7 +395,13 @@ If ARG is non-nil, mark the key."
(car epa-list-keys-arguments)))))
(list (if (equal name "") nil name)))
(list nil)))
- (epa--list-keys name nil))
+ (epa--list-keys name nil
+ "The letters at the start of a line have these meanings.
+e expired key. n never trust. m trust marginally. u trust ultimately.
+f trust fully (keys you have signed, usually).
+q trust status questionable. - trust status unspecified.
+ See GPG documentation for more explanation.
+\n"))
;;;###autoload
(defun epa-list-secret-keys (&optional name)
@@ -430,40 +435,34 @@ If ARG is non-nil, mark the key."
(unless (and epa-keys-buffer
(buffer-live-p epa-keys-buffer))
(setq epa-keys-buffer (generate-new-buffer "*Keys*")))
- (with-current-buffer epa-keys-buffer
- (epa-key-list-mode)
- ;; C-c C-c is the usual way to finish the selection (bug#11159).
- (define-key (current-local-map) "\C-c\C-c" 'exit-recursive-edit)
- (let ((inhibit-read-only t)
- buffer-read-only)
- (erase-buffer)
- (insert prompt "\n"
- (substitute-command-keys "\
+ (save-window-excursion
+ (with-current-buffer epa-keys-buffer
+ (epa-key-list-mode)
+ ;; C-c C-c is the usual way to finish the selection (bug#11159).
+ (define-key (current-local-map) "\C-c\C-c" 'exit-recursive-edit)
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (erase-buffer)
+ (insert prompt "\n"
+ (substitute-command-keys "\
- `\\[epa-mark-key]' to mark a key on the line
- `\\[epa-unmark-key]' to unmark a key on the line\n"))
- (widget-create 'push-button
- :notify (lambda (&rest _ignore) (abort-recursive-edit))
- :help-echo
- "Click here or \\[abort-recursive-edit] to cancel"
- "Cancel")
- (widget-create 'push-button
- :notify (lambda (&rest _ignore) (exit-recursive-edit))
- :help-echo
- "Click here or \\[exit-recursive-edit] to finish"
- "OK")
- (insert "\n\n")
- (epa--insert-keys keys)
- (widget-setup)
- (set-keymap-parent (current-local-map) widget-keymap)
- (setq epa-exit-buffer-function #'abort-recursive-edit)
- (goto-char (point-min))
- (let ((display-buffer-mark-dedicated 'soft))
- (pop-to-buffer (current-buffer))))
- (unwind-protect
- (progn
- (recursive-edit)
- (epa--marked-keys))
- (kill-buffer epa-keys-buffer))))
+ (insert-button "[Cancel]"
+ 'action (lambda (_button) (abort-recursive-edit)))
+ (insert " ")
+ (insert-button "[OK]"
+ 'action (lambda (_button) (exit-recursive-edit)))
+ (insert "\n\n")
+ (epa--insert-keys keys)
+ (setq epa-exit-buffer-function #'abort-recursive-edit)
+ (goto-char (point-min))
+ (let ((display-buffer-mark-dedicated 'soft))
+ (pop-to-buffer (current-buffer))))
+ (unwind-protect
+ (progn
+ (recursive-edit)
+ (epa--marked-keys))
+ (kill-buffer epa-keys-buffer)))))
;;;###autoload
(defun epa-select-keys (context prompt &optional names secret)
@@ -476,6 +475,16 @@ If SECRET is non-nil, list secret keys instead of public keys."
(let ((keys (epg-list-keys context names secret)))
(epa--select-keys prompt keys)))
+;;;; Key Details
+
+(defun epa-show-key ()
+ "Show a key on the current line."
+ (interactive)
+ (if-let ((key (get-text-property (point) 'epa-key)))
+ (save-selected-window
+ (epa--show-key key))
+ (error "No key on this line")))
+
(defun epa--show-key (key)
(let* ((primary-sub-key (car (epg-key-sub-key-list key)))
(entry (assoc (epg-sub-key-id primary-sub-key)
@@ -554,6 +563,8 @@ If SECRET is non-nil, list secret keys instead of public keys."
(goto-char (point-min))
(pop-to-buffer (current-buffer))))
+;;;; Encryption and Signatures
+
(defun epa-display-info (info)
(if epa-popup-info-window
(save-selected-window
@@ -607,10 +618,6 @@ If SECRET is non-nil, list secret keys instead of public keys."
(goto-char (point-min)))
(display-buffer buffer)))))
-(defun epa-display-verify-result (verify-result)
- (declare (obsolete epa-display-info "23.1"))
- (epa-display-info (epg-verify-result-to-string verify-result)))
-
(defun epa-passphrase-callback-function (context key-id handback)
(if (eq key-id 'SYM)
(read-passwd
@@ -1068,16 +1075,7 @@ If no one is selected, default secret key is used. "
'start-open t
'end-open t)))))
-(defalias 'epa--derived-mode-p
- (if (fboundp 'derived-mode-p)
- #'derived-mode-p
- (lambda (&rest modes)
- "Non-nil if the current major mode is derived from one of MODES.
-Uses the `derived-mode-parent' property of the symbol to trace backwards."
- (let ((parent major-mode))
- (while (and (not (memq parent modes))
- (setq parent (get parent 'derived-mode-parent))))
- parent))))
+(define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1")
;;;###autoload
(defun epa-encrypt-region (start end recipients sign signers)
@@ -1154,6 +1152,8 @@ If no one is selected, symmetric encryption will be performed. ")
'start-open t
'end-open t)))))
+;;;; Key Management
+
;;;###autoload
(defun epa-delete-keys (keys &optional allow-secret)
"Delete selected KEYS."
@@ -1190,7 +1190,7 @@ If no one is selected, symmetric encryption will be performed. ")
(if (epg-context-result-for context 'import)
(epa-display-info (epg-import-result-to-string
(epg-context-result-for context 'import))))
- ;; FIXME: Why not use the (otherwise unused) epa--derived-mode-p?
+ ;; FIXME: Why not use the derived-mode-p?
(if (eq major-mode 'epa-key-list-mode)
(apply #'epa--list-keys epa-list-keys-arguments))))
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index daa9a5abd17..9f0c7e4c509 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -22,6 +22,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Prelude
(eval-when-compile (require 'cl-lib))
@@ -34,6 +35,8 @@
(define-obsolete-variable-alias 'epg-bug-report-address
'report-emacs-bug-address "27.1")
+;;; Options
+
(defgroup epg ()
"Interface to the GNU Privacy Guard (GnuPG)."
:tag "EasyPG"
@@ -106,6 +109,8 @@ through the minibuffer, instead of external Pinentry program."
Note that the buffer name starts with a space."
:type 'boolean)
+;;; Constants
+
(defconst epg-gpg-minimum-version "1.4.3")
(defconst epg-gpg2-minimum-version "2.1.6")
@@ -133,6 +138,8 @@ The first element of each entry is protocol symbol, which is
either `OpenPGP' or `CMS'. The second element is a function
which constructs a configuration object (actually a plist).")
+;;; "Configuration"
+
(defvar epg--configurations nil)
;;;###autoload
@@ -202,13 +209,13 @@ version requirement is met."
(cond
((eq type 'group)
(if (string-match "\\`\\([^:]+\\):" args)
- (setq groups
- (cons (cons (downcase (match-string 1 args))
- (delete "" (split-string
- (substring args
- (match-end 0))
- ";")))
- groups))
+ (setq groups
+ (cons (cons (downcase (match-string 1 args))
+ (delete "" (split-string
+ (substring args
+ (match-end 0))
+ ";")))
+ groups))
(if epg-debug
(message "Invalid group configuration: %S" args))))
((memq type '(pubkey cipher digest compress))
diff --git a/lisp/epg.el b/lisp/epg.el
index 222fd913e17..920b85398f3 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1,4 +1,5 @@
;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
+
;; Copyright (C) 1999-2000, 2002-2020 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -21,10 +22,15 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
+;;; Prelude
(require 'epg-config)
(eval-when-compile (require 'cl-lib))
+(define-error 'epg-error "GPG error")
+
+;;; Variables
+
(defvar epg-user-id nil
"GnuPG ID of your default identity.")
@@ -41,6 +47,8 @@
(defvar epg-agent-file nil)
(defvar epg-agent-mtime nil)
+;;; Enums
+
;; from gnupg/common/openpgpdefs.h
(defconst epg-cipher-algorithm-alist
'((0 . "NONE")
@@ -123,7 +131,7 @@
(defconst epg-no-data-reason-alist
'((1 . "No armored data")
- (2 . "Expected a packet but did not found one")
+ (2 . "Expected a packet but did not find one")
(3 . "Invalid packet found, this may indicate a non OpenPGP message")
(4 . "Signature expected but not found")))
@@ -169,7 +177,8 @@
(defvar epg-prompt-alist nil)
-(define-error 'epg-error "GPG error")
+;;; Structs
+;;;; Data Struct
(cl-defstruct (epg-data
(:constructor nil)
@@ -180,6 +189,9 @@
(file nil :read-only t)
(string nil :read-only t))
+;;;; Context Struct
+(declare-function epa-passphrase-callback-function "epa.el")
+
(cl-defstruct (epg-context
(:constructor nil)
(:constructor epg-context--make
@@ -204,7 +216,7 @@
cipher-algorithm
digest-algorithm
compress-algorithm
- (passphrase-callback (list #'epg-passphrase-callback-function))
+ (passphrase-callback (list #'epa-passphrase-callback-function))
progress-callback
edit-callback
signers
@@ -218,6 +230,8 @@
(error-output "")
error-buffer)
+;;;; Context Methods
+
;; This is not an alias, just so we can mark it as autoloaded.
;;;###autoload
(defun epg-make-context (&optional protocol armor textmode include-certs
@@ -281,6 +295,8 @@ callback data (if any)."
(declare (obsolete setf "25.1"))
(setf (epg-context-signers context) signers))
+;;;; Other Structs
+
(cl-defstruct (epg-signature
(:constructor nil)
(:constructor epg-make-signature
@@ -385,6 +401,8 @@ callback data (if any)."
secret-unchanged not-imported
imports)
+;;; Functions
+
(defun epg-context-result-for (context name)
"Return the result of CONTEXT associated with NAME."
(cdr (assq name (epg-context-result context))))
@@ -404,37 +422,28 @@ callback data (if any)."
(pubkey-algorithm (epg-signature-pubkey-algorithm signature))
(key-id (epg-signature-key-id signature)))
(concat
- (cond ((eq (epg-signature-status signature) 'good)
- "Good signature from ")
- ((eq (epg-signature-status signature) 'bad)
- "Bad signature from ")
- ((eq (epg-signature-status signature) 'expired)
- "Expired signature from ")
- ((eq (epg-signature-status signature) 'expired-key)
- "Signature made by expired key ")
- ((eq (epg-signature-status signature) 'revoked-key)
- "Signature made by revoked key ")
- ((eq (epg-signature-status signature) 'no-pubkey)
- "No public key for "))
+ (cl-case (epg-signature-status signature)
+ (good "Good signature from ")
+ (bad "Bad signature from ")
+ (expired "Expired signature from ")
+ (expired-key "Signature made by expired key ")
+ (revoked-key "Signature made by revoked key ")
+ (no-pubkey "No public key for "))
key-id
- (if user-id
- (concat " "
- (if (stringp user-id)
- (epg--decode-percent-escape-as-utf-8 user-id)
- (epg-decode-dn user-id)))
- "")
- (if (epg-signature-validity signature)
- (format " (trust %s)" (epg-signature-validity signature))
- "")
- (if (epg-signature-creation-time signature)
- (format-time-string " created at %Y-%m-%dT%T%z"
- (epg-signature-creation-time signature))
- "")
- (if pubkey-algorithm
- (concat " using "
- (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist))
- (format "(unknown algorithm %d)" pubkey-algorithm)))
- ""))))
+ (and user-id
+ (concat " "
+ (if (stringp user-id)
+ (epg--decode-percent-escape-as-utf-8 user-id)
+ (epg-decode-dn user-id))))
+ (and (epg-signature-validity signature)
+ (format " (trust %s)" (epg-signature-validity signature)))
+ (and (epg-signature-creation-time signature)
+ (format-time-string " created at %Y-%m-%dT%T%z"
+ (epg-signature-creation-time signature)))
+ (and pubkey-algorithm
+ (concat " using "
+ (or (cdr (assq pubkey-algorithm epg-pubkey-algorithm-alist))
+ (format "(unknown algorithm %d)" pubkey-algorithm)))))))
(defun epg-verify-result-to-string (verify-result)
"Convert VERIFY-RESULT to a human readable string."
@@ -859,6 +868,8 @@ callback data (if any)."
(format "Untrusted key %s %s. Use anyway? " key-id user-id))
"Use untrusted key anyway? ")))
+;;; Status Functions
+
(defun epg--status-GET_BOOL (context string)
(let (inhibit-quit)
(condition-case nil
@@ -1234,18 +1245,7 @@ callback data (if any)."
(epg-context-result-for context 'import-status)))
(epg-context-set-result-for context 'import-status nil)))
-(defun epg-passphrase-callback-function (context key-id _handback)
- (declare (obsolete epa-passphrase-callback-function "23.1"))
- (if (eq key-id 'SYM)
- (read-passwd "Passphrase for symmetric encryption: "
- (eq (epg-context-operation context) 'encrypt))
- (read-passwd
- (if (eq key-id 'PIN)
- "Passphrase for PIN: "
- (let ((entry (assoc key-id epg-user-id-alist)))
- (if entry
- (format "Passphrase for %s %s: " key-id (cdr entry))
- (format "Passphrase for %s: " key-id)))))))
+;;; Functions
(defun epg--list-keys-1 (context name mode)
(let ((args (append (if (epg-context-home-directory context)
@@ -1303,6 +1303,8 @@ callback data (if any)."
(if (aref line 6)
(epg--time-from-seconds (aref line 6)))))
+;;; Public Functions
+
(defun epg-list-keys (context &optional name mode)
"Return a list of epg-key objects matched with NAME.
If MODE is nil or `public', only public keyring should be searched.
@@ -1683,7 +1685,8 @@ Otherwise, it makes a cleartext signature."
(if (epg-context-result-for context 'error)
(let ((errors (epg-context-result-for context 'error)))
(signal 'epg-error
- (list "Sign failed" (epg-errors-to-string errors))))))
+ (list "Sign failed" (epg-errors-to-string errors))))
+ (signal 'epg-error '("Signing failed (unknown reason)"))))
(epg-read-output context))
(epg-delete-output-file context)
(if input-file
@@ -2031,6 +2034,8 @@ If you are unsure, use synchronous version of this function
(epg-errors-to-string errors))))))
(epg-reset context)))
+;;; Decode Functions
+
(defun epg--decode-percent-escape (string)
(setq string (encode-coding-string string 'raw-text))
(let ((index 0))
diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1
index ef813bd0325..fdf51954684 100644
--- a/lisp/erc/ChangeLog.1
+++ b/lisp/erc/ChangeLog.1
@@ -7296,7 +7296,7 @@
again.
(erc): Require cl for delete-if.
(erc-button-remove-old-buttons): Rewrote using delete-if to
- prevent excesive consing. Having the marker list is still ugly,
+ prevent excessive consing. Having the marker list is still ugly,
so another solution needs to be found.
2003-01-17 Jorgen Schaefer <forcer@users.sourceforge.net>
@@ -9116,7 +9116,7 @@
2002-11-10 Alex Schroeder <alex@gnu.org>
* TODO:
- TODO: moved it to http://www.emacswiki.org/cgi-bin/wiki.pl?ErcTODO
+ TODO: moved it to https://www.emacswiki.org/cgi-bin/wiki.pl?ErcTODO
* erc.el(with-erc-channel-buffer): Rudimentary doc string.
@@ -10260,7 +10260,7 @@
Upcased the command defuns (erc-cmd-join is now erc-cmd-JOIN)
Fixed erc-complete to not require erc-command-table.
Implemented erc-cmd-HELP
- (You have to try that, its tooo coool!)
+ (You have to try that, its too coool!)
e.g. /help auto-q
fixed autoloads for erc-add-pal and so on to be interactive.
@@ -11242,7 +11242,7 @@
2001-10-29 Mario Lang <mlang@delysid.org>
* erc.el:
- Imenu fixed somehow, added IRC services interactive function for indentify to NickServ. Read the diff
+ Imenu fixed somehow, added IRC services interactive function for identify to NickServ. Read the diff
2001-10-26 Gergely Nagy <algernon@debian.org>
@@ -11316,7 +11316,7 @@
* erc-speak.el:
* Very important fix! Now erc-speak is really complete. Messages don't get cut anymore. Be sure to use auditory icons,
- it's reallllly cool now!!!
+ it's really cool now!!!
* erc-speak.el: *** empty log message ***
diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el
index 0950cec4f7f..0923ed6e735 100644
--- a/lisp/erc/erc-autoaway.el
+++ b/lisp/erc/erc-autoaway.el
@@ -54,7 +54,7 @@ If `erc-autoaway-idle-method' is `emacs', you must call this
function each time you change `erc-autoaway-idle-seconds'."
(interactive)
(when erc-autoaway-idletimer
- (erc-cancel-timer erc-autoaway-idletimer))
+ (cancel-timer erc-autoaway-idletimer))
(setq erc-autoaway-idletimer
(run-with-idle-timer erc-autoaway-idle-seconds
t
@@ -133,7 +133,7 @@ Related variables: `erc-public-away-p' and `erc-away-nickname'."
(remove-hook 'erc-after-connect 'erc-autoaway-insinuate-maybe)
(remove-hook 'erc-disconnected-hook 'erc-autoaway-remove-maybe))
((eq erc-autoaway-idle-method 'emacs)
- (erc-cancel-timer erc-autoaway-idletimer)
+ (cancel-timer erc-autoaway-idletimer)
(setq erc-autoaway-idletimer nil)))
(remove-hook 'erc-timer-hook 'erc-autoaway-possibly-set-away)
(remove-hook 'erc-server-305-functions 'erc-autoaway-reset-indicators))))
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 526e854beca..f99088d4c78 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -98,7 +98,6 @@
;;; Code:
-(require 'erc-compat)
(eval-when-compile (require 'cl-lib))
;; There's a fairly strong mutual dependency between erc.el and erc-backend.el.
;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the
@@ -375,7 +374,7 @@ Example: If you know that the channel #linux-ru uses the coding-system
`cyrillic-koi8', then add (\"#linux-ru\" . cyrillic-koi8) to the
alist."
:group 'erc-server
- :type '(repeat (cons (string :tag "Target")
+ :type '(repeat (cons (regexp :tag "Target")
coding-system)))
(defcustom erc-server-connect-function #'erc-open-network-stream
@@ -409,7 +408,7 @@ This string is processed using `format-time-string'."
;;; Flood-related
;; Most of this is courtesy of Jorgen Schaefer and Circe
-;; (http://www.nongnu.org/circe)
+;; (https://www.nongnu.org/circe)
(defcustom erc-server-flood-margin 10
"A margin on how much excess data we send.
@@ -520,7 +519,8 @@ If no subword-mode is active, then this is
"Set up a timer to periodically ping the current server.
The current buffer is given by BUFFER."
(with-current-buffer buffer
- (and erc-server-ping-handler (erc-cancel-timer erc-server-ping-handler))
+ (when erc-server-ping-handler
+ (cancel-timer erc-server-ping-handler))
(when erc-server-send-ping-interval
(setq erc-server-ping-handler (run-with-timer
4 erc-server-send-ping-interval
@@ -533,7 +533,7 @@ The current buffer is given by BUFFER."
(if timer-tuple
;; this buffer already has a timer. Cancel it and set the new one
(progn
- (erc-cancel-timer (cdr timer-tuple))
+ (cancel-timer (cdr timer-tuple))
(setf (cdr (assq buffer erc-server-ping-timer-alist)) erc-server-ping-handler))
;; no existing timer for this buffer. Add new one
@@ -731,7 +731,7 @@ Conditionally try to reconnect and take appropriate action."
(erc-with-all-buffers-of-server cproc nil
(setq erc-server-connected nil))
(when erc-server-ping-handler
- (progn (erc-cancel-timer erc-server-ping-handler)
+ (progn (cancel-timer erc-server-ping-handler)
(setq erc-server-ping-handler nil)))
(run-hook-with-args 'erc-disconnected-hook
(erc-current-nick) (system-name) "")
@@ -781,7 +781,7 @@ value of `erc-server-coding-system'."
(pop precedence))
(when precedence
(setq coding (car precedence)))))
- (erc-decode-coding-string str coding)))
+ (decode-coding-string str coding t)))
;; proposed name, not used by anything yet
(defun erc-send-line (text display-fn)
@@ -856,7 +856,7 @@ Additionally, detect whether the IRC process has hung."
;; remove timer if the server buffer has been killed
(let ((timer (assq buf erc-server-ping-timer-alist)))
(when timer
- (erc-cancel-timer (cdr timer))
+ (cancel-timer (cdr timer))
(setcdr timer nil)))))
;; From Circe
@@ -864,41 +864,42 @@ Additionally, detect whether the IRC process has hung."
"Send messages in `erc-server-flood-queue'.
See `erc-server-flood-margin' for an explanation of the flood
protection algorithm."
- (with-current-buffer buffer
- (let ((now (current-time)))
- (when erc-server-flood-timer
- (erc-cancel-timer erc-server-flood-timer)
- (setq erc-server-flood-timer nil))
- (when (time-less-p erc-server-flood-last-message now)
- (setq erc-server-flood-last-message (erc-emacs-time-to-erc-time now)))
- (while (and erc-server-flood-queue
- (time-less-p erc-server-flood-last-message
- (time-add now erc-server-flood-margin)))
- (let ((msg (caar erc-server-flood-queue))
- (encoding (cdar erc-server-flood-queue)))
- (setq erc-server-flood-queue (cdr erc-server-flood-queue)
- erc-server-flood-last-message
- (+ erc-server-flood-last-message
- erc-server-flood-penalty))
- (erc-log-irc-protocol msg 'outbound)
- (erc-log (concat "erc-server-send-queue: "
- msg "(" (buffer-name buffer) ")"))
- (when (erc-server-process-alive)
- (condition-case nil
- ;; Set encoding just before sending the string
- (progn
- (when (fboundp 'set-process-coding-system)
- (set-process-coding-system erc-server-process
- 'raw-text encoding))
- (process-send-string erc-server-process msg))
- ;; Sometimes the send can occur while the process is
- ;; being killed, which results in a weird SIGPIPE error.
- ;; Catch this and ignore it.
- (error nil)))))
- (when erc-server-flood-queue
- (setq erc-server-flood-timer
- (run-at-time (+ 0.2 erc-server-flood-penalty)
- nil #'erc-server-send-queue buffer))))))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (let ((now (current-time)))
+ (when erc-server-flood-timer
+ (cancel-timer erc-server-flood-timer)
+ (setq erc-server-flood-timer nil))
+ (when (time-less-p erc-server-flood-last-message now)
+ (setq erc-server-flood-last-message (erc-emacs-time-to-erc-time now)))
+ (while (and erc-server-flood-queue
+ (time-less-p erc-server-flood-last-message
+ (time-add now erc-server-flood-margin)))
+ (let ((msg (caar erc-server-flood-queue))
+ (encoding (cdar erc-server-flood-queue)))
+ (setq erc-server-flood-queue (cdr erc-server-flood-queue)
+ erc-server-flood-last-message
+ (+ erc-server-flood-last-message
+ erc-server-flood-penalty))
+ (erc-log-irc-protocol msg 'outbound)
+ (erc-log (concat "erc-server-send-queue: "
+ msg "(" (buffer-name buffer) ")"))
+ (when (erc-server-process-alive)
+ (condition-case nil
+ ;; Set encoding just before sending the string
+ (progn
+ (when (fboundp 'set-process-coding-system)
+ (set-process-coding-system erc-server-process
+ 'raw-text encoding))
+ (process-send-string erc-server-process msg))
+ ;; Sometimes the send can occur while the process is
+ ;; being killed, which results in a weird SIGPIPE error.
+ ;; Catch this and ignore it.
+ (error nil)))))
+ (when erc-server-flood-queue
+ (setq erc-server-flood-timer
+ (run-at-time (+ 0.2 erc-server-flood-penalty)
+ nil #'erc-server-send-queue buffer)))))))
(defun erc-message (message-command line &optional force)
"Send LINE to the server as a privmsg or a notice.
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 5e6f7c8d107..b799b2427c6 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -198,12 +198,12 @@ PAR is a number of a regexp grouping whose text will be passed to
:inline t
(integer :tag "Regexp section number")))))
-(defcustom erc-emacswiki-url "http://www.emacswiki.org/cgi-bin/wiki.pl?"
+(defcustom erc-emacswiki-url "https://www.emacswiki.org/cgi-bin/wiki.pl?"
"URL of the EmacsWiki Homepage."
:group 'erc-button
:type 'string)
-(defcustom erc-emacswiki-lisp-url "http://www.emacswiki.org/elisp/"
+(defcustom erc-emacswiki-lisp-url "https://www.emacswiki.org/elisp/"
"URL of the EmacsWiki ELisp area."
:group 'erc-button
:type 'string)
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index fc45725f789..4afe6a7614b 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -170,11 +170,11 @@ PARSED is an `erc-parsed' response struct."
(string-match "^\\([-\\+]\\)\\(.+\\)$" msg))
(setf (erc-response.contents parsed)
(if erc-capab-identify-mode
- (erc-propertize (match-string 2 msg)
- 'erc-identified
- (if (string= (match-string 1 msg) "+")
- 1
- 0))
+ (propertize (match-string 2 msg)
+ 'erc-identified
+ (if (string= (match-string 1 msg) "+")
+ 1
+ 0))
(match-string 2 msg)))
nil)))
@@ -190,9 +190,9 @@ PARSED is an `erc-parsed' response struct."
;; assuming the first use of `nickname' is the sender's nick
(re-search-forward (regexp-quote nickname) nil t))
(goto-char (match-beginning 0))
- (insert (erc-propertize erc-capab-identify-prefix
- 'font-lock-face
- 'erc-capab-identify-unidentified))))))
+ (insert (propertize erc-capab-identify-prefix
+ 'font-lock-face
+ 'erc-capab-identify-unidentified))))))
(defun erc-capab-identify-get-unidentified-nickname (parsed)
"Return the nickname of the user if unidentified.
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 26701cec1e4..1bce986a806 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -419,15 +419,15 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(pcomplete-here
(pcase (intern (downcase (pcomplete-arg 1)))
('chat (mapcar (lambda (elt) (plist-get elt :nick))
- (erc-remove-if-not
+ (cl-remove-if-not
#'(lambda (elt)
(eq (plist-get elt :type) 'CHAT))
erc-dcc-list)))
- ('close (erc-delete-dups
+ ('close (delete-dups
(mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
erc-dcc-list)))
('get (mapcar #'erc-dcc-nick
- (erc-remove-if-not
+ (cl-remove-if-not
#'(lambda (elt)
(eq (plist-get elt :type) 'GET))
erc-dcc-list)))
@@ -435,7 +435,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(pcomplete-here
(pcase (intern (downcase (pcomplete-arg 2)))
('get (mapcar (lambda (elt) (plist-get elt :file))
- (erc-remove-if-not
+ (cl-remove-if-not
#'(lambda (elt)
(and (eq (plist-get elt :type) 'GET)
(erc-nick-equal-p (erc-extract-nick
@@ -443,7 +443,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(pcomplete-arg 1))))
erc-dcc-list)))
('close (mapcar #'erc-dcc-nick
- (erc-remove-if-not
+ (cl-remove-if-not
#'(lambda (elt)
(eq (plist-get elt :type)
(intern (upcase (pcomplete-arg 1)))))
@@ -516,8 +516,8 @@ PROC is the server process."
(filename (or file (plist-get elt :file) "unknown")))
(if elt
(let* ((file (read-file-name
- (format "Local filename (default %s): "
- (file-name-nondirectory filename))
+ (format-prompt "Local filename"
+ (file-name-nondirectory filename))
(or erc-dcc-get-default-directory
default-directory)
(expand-file-name (file-name-nondirectory filename)
@@ -627,17 +627,17 @@ that subcommand."
?q query ?n nick ?u login ?h host))))
(defconst erc-dcc-ctcp-query-send-regexp
- (concat "^DCC SEND \\("
+ (concat "^DCC SEND \\(?:"
;; Following part matches either filename without spaces
;; or filename enclosed in double quotes with any number
;; of escaped double quotes inside.
- "\"\\(\\(.*?\\(\\\\\"\\)?\\)+?\\)\"\\|\\([^ ]+\\)"
+ "\"\\(\\(?:\\\\\"\\|[^\"\\]\\)+\\)\"\\|\\([^ ]+\\)"
"\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\)"))
(define-inline erc-dcc-unquote-filename (filename)
(inline-quote
- (erc-replace-regexp-in-string "\\\\\\\\" "\\"
- (erc-replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t)))
+ (replace-regexp-in-string "\\\\\\\\" "\\"
+ (replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t)))
(defun erc-dcc-handle-ctcp-send (proc query nick login host to)
"This is called if a CTCP DCC SEND subcommand is sent to the client.
@@ -653,11 +653,11 @@ It extracts the information about the dcc request and adds it to
?r "SEND" ?n nick ?u login ?h host))
((string-match erc-dcc-ctcp-query-send-regexp query)
(let ((filename
- (or (match-string 5 query)
- (erc-dcc-unquote-filename (match-string 2 query))))
- (ip (erc-decimal-to-ip (match-string 6 query)))
- (port (match-string 7 query))
- (size (match-string 8 query)))
+ (or (match-string 2 query)
+ (erc-dcc-unquote-filename (match-string 1 query))))
+ (ip (erc-decimal-to-ip (match-string 3 query)))
+ (port (match-string 4 query))
+ (size (match-string 5 query)))
;; FIXME: a warning really should also be sent
;; if the ip address != the host the dcc sender is on.
(erc-display-message
@@ -1193,8 +1193,8 @@ other client."
(setq posn (match-end 0))
(erc-display-message
nil nil proc
- 'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'font-lock-face
- 'erc-nick-default-face) ?m line))
+ 'dcc-chat-privmsg ?n (propertize erc-dcc-from 'font-lock-face
+ 'erc-nick-default-face) ?m line))
(setq erc-dcc-unprocessed-output (substring str posn)))))
(defun erc-dcc-chat-buffer-killed ()
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
index 1e65f8f4275..3a9a4a4bac6 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -31,6 +31,7 @@
(require 'erc)
(require 'xml)
(require 'notifications)
+(require 'erc-goodies)
(require 'erc-match)
(require 'dbus)
@@ -62,12 +63,12 @@ This will replace the last notification sent with this function."
;; setting the current buffer to the existing query buffer)
(dbus-ignore-errors
(setq erc-notifications-last-notification
- (let ((channel (if privp (erc-get-buffer nick) (current-buffer))))
+ (let* ((channel (if privp (erc-get-buffer nick) (current-buffer)))
+ (title (format "%s in %s" (xml-escape-string nick t) channel))
+ (body (xml-escape-string (erc-controls-strip msg) t)))
(notifications-notify :bus erc-notifications-bus
- :title (format "%s in %s"
- (xml-escape-string nick)
- channel)
- :body (xml-escape-string msg)
+ :title title
+ :body body
:replaces-id erc-notifications-last-notification
:app-icon erc-notifications-icon
:actions '("default" "Switch to buffer")
diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el
index 1032af7a304..5c2faff96de 100644
--- a/lisp/erc/erc-ezbounce.el
+++ b/lisp/erc/erc-ezbounce.el
@@ -34,7 +34,7 @@
(defcustom erc-ezb-regexp "^ezbounce!srv$"
"Regexp used by the EZBouncer to identify itself to the user."
:group 'erc-ezbounce
- :type 'string)
+ :type 'regexp)
(defcustom erc-ezb-login-alist '()
"Alist of logins suitable for the server we're connecting to.
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 39a8be5e0cf..d09caf7aa12 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,7 +38,7 @@
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(erc-define-minor-mode erc-fill-mode
+(define-minor-mode erc-fill-mode
"Toggle ERC fill mode.
With a prefix argument ARG, enable ERC fill mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 94d5de280c6..a475f0a1770 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -232,6 +232,10 @@ The value `erc-interpret-controls-p' must also be t for this to work."
"ERC bold face."
:group 'erc-faces)
+(defface erc-italic-face '((t :slant italic))
+ "ERC italic face."
+ :group 'erc-faces)
+
(defface erc-inverse-face
'((t :foreground "White" :background "Black"))
"ERC inverse face."
@@ -383,6 +387,7 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
(erc-controls-strip s))
(erc-interpret-controls-p
(let ((boldp nil)
+ (italicp nil)
(inversep nil)
(underlinep nil)
(fg nil)
@@ -394,13 +399,14 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
(start (match-beginning 0))
(end (+ (match-beginning 0)
(length (match-string 5 s)))))
- (setq s (erc-replace-match-subexpression-in-string
- "" s control 1 start))
+ (setq s (replace-match "" nil nil s 1))
(cond ((and erc-interpret-mirc-color (or fg-color bg-color))
(setq fg fg-color)
(setq bg bg-color))
((string= control "\C-b")
(setq boldp (not boldp)))
+ ((string= control "\C-]")
+ (setq italicp (not italicp)))
((string= control "\C-v")
(setq inversep (not inversep)))
((string= control "\C-_")
@@ -413,13 +419,14 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
(ding)))
((string= control "\C-o")
(setq boldp nil
+ italicp nil
inversep nil
underlinep nil
fg nil
bg nil))
(t nil))
(erc-controls-propertize
- start end boldp inversep underlinep fg bg s)))
+ start end boldp italicp inversep underlinep fg bg s)))
s))
(t s)))))
@@ -432,13 +439,13 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
s)))
(defvar erc-controls-remove-regexp
- "\C-b\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?"
+ "\C-b\\|\C-]\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?"
"Regular expression which matches control characters to remove.")
(defvar erc-controls-highlight-regexp
- (concat "\\(\C-b\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|"
+ (concat "\\(\C-b\\|\C-]\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|"
"\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)"
- "\\([^\C-b\C-v\C-_\C-c\C-g\C-o\n]*\\)")
+ "\\([^\C-b\C-]\C-v\C-_\C-c\C-g\C-o\n]*\\)")
"Regular expression which matches control chars and the text to highlight.")
(defun erc-controls-highlight ()
@@ -451,6 +458,7 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'."
(replace-match "")))
(erc-interpret-controls-p
(let ((boldp nil)
+ (italicp nil)
(inversep nil)
(underlinep nil)
(fg nil)
@@ -467,6 +475,8 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'."
(setq bg bg-color))
((string= control "\C-b")
(setq boldp (not boldp)))
+ ((string= control "\C-]")
+ (setq italicp (not italicp)))
((string= control "\C-v")
(setq inversep (not inversep)))
((string= control "\C-_")
@@ -479,16 +489,17 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'."
(ding)))
((string= control "\C-o")
(setq boldp nil
+ italicp nil
inversep nil
underlinep nil
fg nil
bg nil))
(t nil))
(erc-controls-propertize start end
- boldp inversep underlinep fg bg)))))
+ boldp italicp inversep underlinep fg bg)))))
(t nil)))
-(defun erc-controls-propertize (from to boldp inversep underlinep fg bg
+(defun erc-controls-propertize (from to boldp italicp inversep underlinep fg bg
&optional str)
"Prepend properties from IRC control characters between FROM and TO.
If optional argument STR is provided, apply to STR, otherwise prepend properties
@@ -500,6 +511,9 @@ to a region in the current buffer."
(append (if boldp
'(erc-bold-face)
nil)
+ (if italicp
+ '(erc-italic-face)
+ nil)
(if inversep
'(erc-inverse-face)
nil)
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index 7aee7705fff..556a25e3e7b 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -92,10 +92,14 @@
" "))
(define-ibuffer-column erc-server-name (:name "Server")
- (if (and erc-server-process (processp erc-server-process))
- (with-current-buffer (process-buffer erc-server-process)
- (or erc-server-announced-name erc-session-server))
- ""))
+ (or
+ (when (and erc-server-process (processp erc-server-process))
+ (let ((buffer (process-buffer erc-server-process)))
+ (if (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (or erc-server-announced-name erc-session-server))
+ "(closed)")))
+ ""))
(define-ibuffer-column erc-target (:name "Target")
(if (eq major-mode 'erc-mode)
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index 280d6bfe0f1..79c111082f6 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -113,7 +113,7 @@ servers, presumably in the same domain."
This is called from a timer set up by `erc-autojoin-channels'."
(if erc--autojoin-timer
(setq erc--autojoin-timer
- (erc-cancel-timer erc--autojoin-timer)))
+ (cancel-timer erc--autojoin-timer)))
(with-current-buffer buffer
;; Don't kick of another delayed autojoin or try to wait for
;; another ident response:
@@ -127,7 +127,7 @@ This is called from a timer set up by `erc-autojoin-channels'."
This function is run from `erc-nickserv-identified-hook'."
(if erc--autojoin-timer
(setq erc--autojoin-timer
- (erc-cancel-timer erc--autojoin-timer)))
+ (cancel-timer erc--autojoin-timer)))
(when (eq erc-autojoin-timing 'ident)
(let ((server (or erc-session-server erc-server-announced-name))
(joined (mapcar (lambda (buf)
@@ -153,18 +153,20 @@ This function is run from `erc-nickserv-identified-hook'."
'erc-autojoin-channels-delayed
server nick (current-buffer))))
;; `erc-autojoin-timing' is `connect':
- (dolist (l erc-autojoin-channels-alist)
- (when (string-match (car l) server)
- (let ((server (or erc-session-server erc-server-announced-name)))
+ (let ((server (or erc-session-server erc-server-announced-name)))
+ (dolist (l erc-autojoin-channels-alist)
+ (when (string-match-p (car l) server)
(dolist (chan (cdr l))
- (let ((buffer (erc-get-buffer chan)))
- ;; Only auto-join the channels that we aren't already in
- ;; using a different nick.
+ (let ((buffer
+ (car (erc-buffer-filter
+ (lambda ()
+ (let ((current (erc-default-target)))
+ (and (stringp current)
+ (string-match-p (car l)
+ (or erc-session-server erc-server-announced-name))
+ (string-equal (erc-downcase chan)
+ (erc-downcase current)))))))))
(when (or (not buffer)
- ;; If the same channel is joined on another
- ;; server the best-effort is to just join
- (not (string-match (car l)
- (process-name erc-server-process)))
(not (with-current-buffer buffer
(erc-server-process-alive))))
(erc-server-join-channel server chan))))))))
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el
index 5faeabb721a..036d7733ed7 100644
--- a/lisp/erc/erc-list.el
+++ b/lisp/erc/erc-list.el
@@ -71,13 +71,13 @@
(defun erc-list-make-string (channel users topic)
(concat
channel
- (erc-propertize " "
- 'display (list 'space :align-to erc-list-nusers-column)
- 'face 'fixed-pitch)
+ (propertize " "
+ 'display (list 'space :align-to erc-list-nusers-column)
+ 'face 'fixed-pitch)
users
- (erc-propertize " "
- 'display (list 'space :align-to erc-list-topic-column)
- 'face 'fixed-pitch)
+ (propertize " "
+ 'display (list 'space :align-to erc-list-topic-column)
+ 'face 'fixed-pitch)
topic))
;; Insert a record into the list buffer.
@@ -143,19 +143,19 @@
;; Helper function that makes a buttonized column header.
(defun erc-list-button (title column)
- (erc-propertize title
- 'column-number column
- 'help-echo "mouse-1: sort by column"
- 'mouse-face 'header-line-highlight
- 'keymap erc-list-menu-sort-button-map))
+ (propertize title
+ 'column-number column
+ 'help-echo "mouse-1: sort by column"
+ 'mouse-face 'header-line-highlight
+ 'keymap erc-list-menu-sort-button-map))
(define-derived-mode erc-list-menu-mode special-mode "ERC-List"
"Major mode for editing a list of irc channels."
(setq header-line-format
(concat
- (erc-propertize " "
- 'display '(space :align-to 0)
- 'face 'fixed-pitch)
+ (propertize " "
+ 'display '(space :align-to 0)
+ 'face 'fixed-pitch)
(erc-list-make-string (erc-list-button "Channel" 1)
(erc-list-button "# Users" 2)
"Topic")))
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 1bad6d16c87..de0a16ea3f0 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -267,7 +267,7 @@ The current buffer is given by BUFFER."
(with-current-buffer buffer
(auto-save-mode -1)
(setq buffer-file-name nil)
- (erc-set-write-file-functions '(erc-save-buffer-in-logs))
+ (add-hook 'write-file-functions #'erc-save-buffer-in-logs nil t)
(when erc-log-insert-log-on-open
(ignore-errors
(save-excursion
@@ -334,7 +334,7 @@ This will not work with full paths, only names.
Any unsafe characters in the name are replaced with \"!\". The
filename is downcased."
- (downcase (erc-replace-regexp-in-string
+ (downcase (replace-regexp-in-string
"[/\\]" "!" (convert-standard-filename filename))))
(defun erc-current-logfile (&optional buffer)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 3107ff2ccd1..b3145674f29 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -94,7 +94,9 @@ The following values are allowed:
`nick-or-keyword' - highlight the nick of the user who typed your nickname,
or all instances of the current nickname if there was
no sending user
- `all' - highlight the entire message where current nickname occurs
+ `message' - highlight the entire message where current nickname occurs
+ `all' - highlight the entire message (including the nick) where
+ current nickname occurs
Any other value disables highlighting of current nickname altogether."
:group 'erc-match
@@ -102,6 +104,7 @@ Any other value disables highlighting of current nickname altogether."
(const nick)
(const keyword)
(const nick-or-keyword)
+ (const message)
(const all)))
(defcustom erc-pal-highlight-type 'nick
@@ -110,14 +113,17 @@ See `erc-pals'.
The following values are allowed:
- nil - do not highlight the message at all
- `nick' - highlight pal's nickname only
- `all' - highlight the entire message from pal
+ nil - do not highlight the message at all
+ `nick' - highlight pal's nickname only
+ `message' - highlight the entire message from pal
+ `all' - highlight the entire message (including the nick)
+ from pal
Any other value disables pal highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const nick)
+ (const message)
(const all)))
(defcustom erc-fool-highlight-type 'nick
@@ -126,14 +132,17 @@ See `erc-fools'.
The following values are allowed:
- nil - do not highlight the message at all
- `nick' - highlight fool's nickname only
- `all' - highlight the entire message from fool
+ nil - do not highlight the message at all
+ `nick' - highlight fool's nickname only
+ `message' - highlight the entire message from fool
+ `all' - highlight the entire message (including the nick)
+ from fool
Any other value disables fool highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const nick)
+ (const message)
(const all)))
(defcustom erc-keyword-highlight-type 'keyword
@@ -143,12 +152,15 @@ See variable `erc-keywords'.
The following values are allowed:
`keyword' - highlight keyword only
- `all' - highlight the entire message containing keyword
+ `message' - highlight the entire message containing keyword
+ `all' - highlight the entire message (including the nick)
+ containing keyword
Any other value disables keyword highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const keyword)
+ (const message)
(const all)))
(defcustom erc-dangerous-host-highlight-type 'nick
@@ -157,13 +169,16 @@ See `erc-dangerous-hosts'.
The following values are allowed:
- `nick' - highlight nick from dangerous-host only
- `all' - highlight the entire message from dangerous-host
+ `nick' - highlight nick from dangerous-host only
+ `message' - highlight the entire message from dangerous-host
+ `all' - highlight the entire message (including the nick)
+ from dangerous-host
Any other value disables dangerous-host highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const nick)
+ (const message)
(const all)))
@@ -449,19 +464,18 @@ Use this defun with `erc-insert-modify-hook'."
(match-beginning 0)))
(nick-end (when nick-beg
(match-end 0)))
- (message (buffer-substring
- (if (and nick-end
- (<= (+ 2 nick-end) (point-max)))
- ;; Message starts 2 characters after the nick
- ;; except for CTCP ACTION messages. Nick
- ;; surrounded by angle brackets only in normal
- ;; messages.
- (+ nick-end
- (if (eq ?> (char-after nick-end))
- 2
- 1))
- (point-min))
- (point-max))))
+ (message-beg (if (and nick-end
+ (<= (+ 2 nick-end) (point-max)))
+ ;; Message starts 2 characters after the
+ ;; nick except for CTCP ACTION messages.
+ ;; Nick surrounded by angle brackets only in
+ ;; normal messages.
+ (+ nick-end
+ (if (eq ?> (char-after nick-end))
+ 2
+ 1))
+ (point-min)))
+ (message (buffer-substring message-beg (point-max))))
(when (and vector
(not (and erc-match-exclude-server-buffer
(erc-server-buffer-p))))
@@ -498,7 +512,12 @@ Use this defun with `erc-insert-modify-hook'."
(while (re-search-forward match-regex nil t)
(erc-put-text-property (match-beginning 0) (match-end 0)
'font-lock-face match-face))))
- ;; Highlight the whole message
+ ;; Highlight the whole message (not including the nick)
+ ((eq match-htype 'message)
+ (erc-put-text-property
+ message-beg (point-max)
+ 'font-lock-face match-face (current-buffer)))
+ ;; Highlight the whole message (including the nick)
((eq match-htype 'all)
(erc-put-text-property
(point-min) (point-max)
@@ -555,16 +574,15 @@ See `erc-log-match-format'."
(and (eq erc-log-matches-flag 'away)
(erc-away-time)))
match-buffer-name)
- (let ((line (format-spec erc-log-match-format
- (format-spec-make
- ?n nick
- ?t (format-time-string
- (or (and (boundp 'erc-timestamp-format)
- erc-timestamp-format)
- "[%Y-%m-%d %H:%M] "))
- ?c (or (erc-default-target) "")
- ?m message
- ?u nickuserhost))))
+ (let ((line (format-spec
+ erc-log-match-format
+ `((?n . ,nick)
+ (?t . ,(format-time-string
+ (or (bound-and-true-p erc-timestamp-format)
+ "[%Y-%m-%d %H:%M] ")))
+ (?c . ,(or (erc-default-target) ""))
+ (?m . ,message)
+ (?u . ,nickuserhost)))))
(with-current-buffer (erc-log-matches-make-buffer match-buffer-name)
(let ((inhibit-read-only t))
(goto-char (point-max))
@@ -578,9 +596,9 @@ See `erc-log-match-format'."
(with-current-buffer buffer
(unless buffer-already
(insert " == Type \"q\" to dismiss messages ==\n")
- (erc-view-mode-enter nil (lambda (buffer)
- (when (y-or-n-p "Discard messages? ")
- (kill-buffer buffer)))))
+ (view-mode-enter nil (lambda (buffer)
+ (when (y-or-n-p "Discard messages? ")
+ (kill-buffer buffer)))))
buffer)))
(defun erc-log-matches-come-back (proc parsed)
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 1234962c51c..d957fcee056 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -152,7 +152,7 @@
("EFnet: EU, PL, Warszawa" EFnet "irc.efnet.pl" 6667)
("EFnet: EU, RU, Moscow" EFnet "irc.rt.ru" ((6661 6669)))
("EFnet: EU, SE, Dalarna" EFnet "irc.du.se" ((6666 6669)))
- ("EFnet: EU, SE, Gothenberg" EFnet "irc.hemmet.chalmers.se" ((6666 7000)))
+ ("EFnet: EU, SE, Gothenburg" EFnet "irc.hemmet.chalmers.se" ((6666 7000)))
("EFnet: EU, SE, Sweden" EFnet "irc.light.se" 6667)
("EFnet: EU, UK, London (carrier)" EFnet "irc.carrier1.net.uk" ((6666 6669)))
("EFnet: EU, UK, London (demon)" EFnet "efnet.demon.co.uk" ((6665 6669)))
@@ -190,9 +190,9 @@
("Fraggers: Random server" Fraggers "irc.fraggers.co.uk" ((6661 6669) (7000 7001) ))
("FreedomChat: Random server" FreedomChat "chat.freedomchat.net" 6667)
("FreedomIRC: Random server" FreedomIRC "irc.freedomirc.net" 6667)
- ("Freenode: Random server" freenode "irc.freenode.net" 6667)
- ("Freenode: Random EU server" freenode "irc.eu.freenode.net" 6667)
- ("Freenode: Random US server" freenode "irc.us.freenode.net" 6667)
+ ("Freenode: Random server" freenode "chat.freenode.net" 6667)
+ ("Freenode: Random EU server" freenode "chat.eu.freenode.net" 6667)
+ ("Freenode: Random US server" freenode "chat.us.freenode.net" 6667)
("FunNet: Random server" FunNet "irc.funnet.org" 6667)
("Galaxynet: Random server" GalaxyNet "irc.galaxynet.org" ((6662 6668) 7000 ))
("Galaxynet: AU, NZ, Auckland" GalaxyNet "auckland.nz.galaxynet.org" ((6661 6669)))
@@ -756,8 +756,8 @@ Return the name of this server's network as a symbol."
(erc-with-server-buffer
(intern (downcase (symbol-name erc-network)))))
-(erc-make-obsolete 'erc-current-network 'erc-network
- "Obsolete since erc-networks 1.5")
+(make-obsolete 'erc-current-network 'erc-network
+ "Obsolete since erc-networks 1.5")
(defun erc-network-name ()
"Return the name of the current network as a string."
@@ -812,7 +812,7 @@ As an example:
(let* ((completion-ignore-case t)
(net (intern
(completing-read "Network: "
- (erc-delete-dups
+ (delete-dups
(mapcar (lambda (x)
(list (symbol-name (nth 1 x))))
erc-server-alist)))))
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el
index 1b092c8a6a9..144a981f832 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -181,7 +181,7 @@ nick from `erc-last-ison' to prevent any further notifications."
(let ((nick (erc-extract-nick (erc-response.sender parsed))))
(when (and (erc-member-ignore-case nick erc-notify-list)
(erc-member-ignore-case nick erc-last-ison))
- (setq erc-last-ison (erc-delete-if
+ (setq erc-last-ison (cl-delete-if
(let ((nick-down (erc-downcase nick)))
(lambda (el)
(string= nick-down (erc-downcase el))))
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index 7643fa85b96..f8b7e13be02 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -41,7 +41,6 @@
(require 'pcomplete)
(require 'erc)
-(require 'erc-compat)
(require 'time-date)
(defgroup erc-pcomplete nil
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index 5a469aa4e4e..b64e42b7ee4 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -90,9 +90,8 @@ nil - Do not sort users"
"Additional menu-items to add to speedbar frame.")
;; Make sure our special speedbar major mode is loaded
-(if (featurep 'speedbar)
- (erc-install-speedbar-variables)
- (add-hook 'speedbar-load-hook 'erc-install-speedbar-variables))
+(with-eval-after-load 'speedbar
+ (erc-install-speedbar-variables))
;;; ERC hierarchy display method
;;;###autoload
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index cbab2f9da2b..08970f2d70e 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -35,7 +35,6 @@
;;; Code:
(require 'erc)
-(require 'erc-compat)
(defgroup erc-stamp nil
"For long conversation on IRC it is sometimes quite
diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el
new file mode 100644
index 00000000000..08dc8d6015f
--- /dev/null
+++ b/lisp/erc/erc-status-sidebar.el
@@ -0,0 +1,309 @@
+;;; erc-status-sidebar.el --- HexChat-like activity overview for ERC
+
+;; Copyright (C) 2017, 2020 Free Software Foundation, Inc.
+
+;; Author: Andrew Barbarello
+;; Maintainer: Amin Bandali <bandali@gnu.org>
+;; URL: https://github.com/drewbarbs/erc-status-sidebar
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides a HexChat-like sidebar for joined channels in
+;; ERC. It relies on the `erc-track' module, and displays all of the
+;; same information that `erc-track' does in the mode line, but in an
+;; alternative format in form of a sidebar.
+
+;; Shout out to sidebar.el <https://github.com/sebastiencs/sidebar.el>
+;; and outline-toc.el <https://github.com/abingham/outline-toc.el> for
+;; the sidebar window management ideas.
+
+;; Usage:
+
+;; Use M-x erc-status-sidebar-open RET to open the ERC status sidebar
+;; in the current frame. Make sure that the `erc-track' module is
+;; active (this is the default).
+
+;; Use M-x erc-status-sidebar-close RET to close the sidebar on the
+;; current frame. With a prefix argument, it closes the sidebar on
+;; all frames.
+
+;; Use M-x erc-status-sidebar-kill RET to kill the sidebar buffer and
+;; close the sidebar on all frames.
+
+;;; Code:
+
+(require 'erc)
+(require 'erc-track)
+(require 'fringe)
+(require 'seq)
+
+(defgroup erc-status-sidebar nil
+ "A sidebar for ERC channel status."
+ :group 'convenience)
+
+(defcustom erc-status-sidebar-buffer-name "*ERC Status*"
+ "Name of the sidebar buffer."
+ :type 'string
+ :group 'erc-status-sidebar)
+
+(defcustom erc-status-sidebar-mode-line-format "ERC Status"
+ "Mode line format for the status sidebar."
+ :type 'string
+ :group 'erc-status-sidebar)
+
+(defcustom erc-status-sidebar-header-line-format nil
+ "Header line format for the status sidebar."
+ :type '(choice (const :tag "No header line" nil)
+ string)
+ :group 'erc-status-sidebar)
+
+(defcustom erc-status-sidebar-width 15
+ "Default width of the sidebar (in columns)."
+ :type 'number
+ :group 'erc-status-sidebar)
+
+(defcustom erc-status-sidebar-channel-sort
+ 'erc-status-sidebar-default-chansort
+ "Sorting function used to determine order of channels in the sidebar."
+ :type 'function
+ :group 'erc-status-sidebar)
+
+(defcustom erc-status-sidebar-channel-format
+ 'erc-status-sidebar-default-chan-format
+ "Function used to format channel names for display in the sidebar."
+ :type 'function
+ :group 'erc-status-sidebar)
+
+(defun erc-status-sidebar-display-window ()
+ "Display the status buffer in a side window. Return the new window."
+ (display-buffer
+ (erc-status-sidebar-get-buffer)
+ `(display-buffer-in-side-window . ((side . left)
+ (window-width . ,erc-status-sidebar-width)))))
+
+(defun erc-status-sidebar-get-window (&optional no-creation)
+ "Return the created/existing window displaying the status buffer.
+
+If NO-CREATION is non-nil, the window is not created."
+ (let ((sidebar-window (get-buffer-window erc-status-sidebar-buffer-name)))
+ (unless (or sidebar-window no-creation)
+ (with-current-buffer (erc-status-sidebar-get-buffer)
+ (setq-local vertical-scroll-bar nil))
+ (setq sidebar-window (erc-status-sidebar-display-window))
+ (set-window-dedicated-p sidebar-window t)
+ (set-window-parameter sidebar-window 'no-delete-other-windows t)
+ ;; Don't cycle to this window with `other-window'.
+ (set-window-parameter sidebar-window 'no-other-window t)
+ (internal-show-cursor sidebar-window nil)
+ (set-window-fringes sidebar-window 0 0)
+ ;; Set a custom display table so the window doesn't show a
+ ;; truncation symbol when a channel name is too big.
+ (let ((dt (make-display-table)))
+ (set-window-display-table sidebar-window dt)
+ (set-display-table-slot dt 'truncation ?\ )))
+ sidebar-window))
+
+(defun erc-status-sidebar-buffer-exists-p ()
+ "Check if the sidebar buffer exists."
+ (get-buffer erc-status-sidebar-buffer-name))
+
+(defun erc-status-sidebar-get-buffer ()
+ "Return the sidebar buffer, creating it if it doesn't exist."
+ (get-buffer-create erc-status-sidebar-buffer-name))
+
+(defun erc-status-sidebar-close (&optional all-frames)
+ "Close the sidebar.
+
+If called with prefix argument (ALL-FRAMES non-nil), the sidebar
+will be closed on all frames.
+
+The erc-status-sidebar buffer is left alone, but the window
+containing it on the current frame is closed. See
+`erc-status-sidebar-kill'."
+ (interactive "P")
+ (mapcar #'delete-window
+ (get-buffer-window-list (erc-status-sidebar-get-buffer)
+ nil (if all-frames t))))
+
+(defmacro erc-status-sidebar-writable (&rest body)
+ "Make the status buffer writable while executing BODY."
+ `(let ((buffer-read-only nil))
+ ,@body))
+
+;;;###autoload
+(defun erc-status-sidebar-open ()
+ "Open or create a sidebar."
+ (interactive)
+ (save-excursion
+ (let ((sidebar-exists (erc-status-sidebar-buffer-exists-p))
+ (sidebar-buffer (erc-status-sidebar-get-buffer))
+ (sidebar-window (erc-status-sidebar-get-window)))
+ (unless sidebar-exists
+ (with-current-buffer sidebar-buffer
+ (erc-status-sidebar-mode)
+ (erc-status-sidebar-refresh))))))
+
+;;;###autoload
+(defun erc-status-sidebar-toggle ()
+ "Toggle the sidebar open/closed on the current frame."
+ (interactive)
+ (if (get-buffer-window erc-status-sidebar-buffer-name nil)
+ (erc-status-sidebar-close)
+ (erc-status-sidebar-open)))
+
+(defun erc-status-sidebar-get-channame (buffer)
+ "Return name of BUFFER with all leading \"#\" characters removed."
+ (let ((s (buffer-name buffer)))
+ (if (string-match "^#\\{1,2\\}" s)
+ (setq s (replace-match "" t t s)))
+ (downcase s)))
+
+(defun erc-status-sidebar-default-chansort (chanlist)
+ "Sort CHANLIST case-insensitively for display in the sidebar."
+ (sort chanlist (lambda (x y)
+ (string< (erc-status-sidebar-get-channame x)
+ (erc-status-sidebar-get-channame y)))))
+
+(defun erc-status-sidebar-default-chan-format (channame
+ &optional num-messages erc-face)
+ "Format CHANNAME for display in the sidebar.
+
+If NUM-MESSAGES is non-nil, append it to the channel name. If
+ERC-FACE is non-nil, apply it to channel name. If it is equal to
+`erc-default-face', also apply bold property to make the channel
+name stand out."
+ (when num-messages
+ (setq channame (format "%s [%d]" channame num-messages)))
+ (when erc-face
+ (put-text-property 0 (length channame) 'face erc-face channame)
+ (when (eq erc-face 'erc-default-face)
+ (add-face-text-property 0 (length channame) 'bold t channame)))
+ channame)
+
+(defun erc-status-sidebar-refresh ()
+ "Update the content of the sidebar."
+ (interactive)
+ (let ((chanlist (apply erc-status-sidebar-channel-sort
+ (erc-channel-list nil) nil)))
+ (with-current-buffer (erc-status-sidebar-get-buffer)
+ (erc-status-sidebar-writable
+ (delete-region (point-min) (point-max))
+ (goto-char (point-min))
+ (dolist (chanbuf chanlist)
+ (let* ((tup (seq-find (lambda (tup) (eq (car tup) chanbuf))
+ erc-modified-channels-alist))
+ (count (if tup (cadr tup)))
+ (face (if tup (cddr tup)))
+ (channame (apply erc-status-sidebar-channel-format
+ (buffer-name chanbuf) count face nil))
+ (cnlen (length channame)))
+ (put-text-property 0 cnlen 'erc-buf chanbuf channame)
+ (put-text-property 0 cnlen 'mouse-face 'highlight channame)
+ (put-text-property
+ 0 cnlen 'help-echo
+ "mouse-1: switch to buffer in other window" channame)
+ (insert channame "\n")))))))
+
+(defun erc-status-sidebar-kill ()
+ "Close the ERC status sidebar and its buffer."
+ (interactive)
+ (ignore-errors (kill-buffer erc-status-sidebar-buffer-name)))
+
+(defun erc-status-sidebar-click (event)
+ "Handle click EVENT in `erc-status-sidebar-mode-map'."
+ (interactive "e")
+ (save-excursion
+ (let ((window (posn-window (event-end event)))
+ (pos (posn-point (event-end event))))
+ (set-buffer (window-buffer window))
+ (let ((buf (get-text-property pos 'erc-buf)))
+ (when buf
+ (select-window window)
+ (switch-to-buffer-other-window buf))))))
+
+(defvar erc-status-sidebar-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map special-mode-map)
+ (define-key map [mouse-1] #'erc-status-sidebar-click)
+ map))
+
+(defvar erc-status-sidebar-refresh-triggers
+ '(erc-track-list-changed-hook
+ erc-join-hook
+ erc-part-hook
+ erc-kill-buffer-hook
+ erc-kill-channel-hook
+ erc-kill-server-hook
+ erc-kick-hook
+ erc-disconnected-hook
+ erc-quit-hook))
+
+(defun erc-status-sidebar--post-refresh (&rest ignore)
+ "Schedule sidebar refresh for execution after command stack is cleared.
+
+Ignore arguments in IGNORE, allowing this function to be added to
+hooks that invoke it with arguments."
+ (run-at-time 0 nil #'erc-status-sidebar-refresh))
+
+(defun erc-status-sidebar-mode--unhook ()
+ "Remove hooks installed by `erc-status-sidebar-mode'."
+ (dolist (hk erc-status-sidebar-refresh-triggers)
+ (remove-hook hk #'erc-status-sidebar--post-refresh))
+ (remove-hook 'window-configuration-change-hook
+ #'erc-status-sidebar-set-window-preserve-size))
+
+(defun erc-status-sidebar-set-window-preserve-size ()
+ "Tell Emacs to preserve the current height/width of the ERC sidebar window.
+
+Note that preserve status needs to be reset when the window is
+manually resized, so `erc-status-sidebar-mode' adds this function
+to the `window-configuration-change-hook'."
+ (when (and (eq (selected-window) (erc-status-sidebar-get-window))
+ (fboundp 'window-preserve-size))
+ (unless (eq (window-total-width) (window-min-size nil t))
+ (apply 'window-preserve-size (selected-window) t t nil))))
+
+(define-derived-mode erc-status-sidebar-mode special-mode "ERC Sidebar"
+ "Major mode for ERC status sidebar"
+ ;; Don't scroll the buffer horizontally, if a channel name is
+ ;; obscured then the window can be resized.
+ (setq-local auto-hscroll-mode nil)
+ (setq cursor-type nil
+ buffer-read-only t
+ mode-line-format erc-status-sidebar-mode-line-format
+ header-line-format erc-status-sidebar-header-line-format)
+ (erc-status-sidebar-set-window-preserve-size)
+
+ (add-hook 'window-configuration-change-hook
+ #'erc-status-sidebar-set-window-preserve-size nil t)
+ (dolist (hk erc-status-sidebar-refresh-triggers)
+ (add-hook hk #'erc-status-sidebar--post-refresh))
+
+ ;; `change-major-mode-hook' is run *before* the
+ ;; erc-status-sidebar-mode initialization code, so it won't undo the
+ ;; add-hook's we did in the previous expressions.
+ (add-hook 'change-major-mode-hook #'erc-status-sidebar-mode--unhook nil t)
+ (add-hook 'kill-buffer-hook #'erc-status-sidebar-mode--unhook nil t)
+ :group 'erc-status-sidebar)
+
+(provide 'erc-status-sidebar)
+;;; erc-status-sidebar.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
+;; End:
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 490b2937771..60f0cfa942f 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -36,7 +36,6 @@
(eval-when-compile (require 'cl-lib))
(require 'erc)
-(require 'erc-compat)
(require 'erc-match)
;;; Code:
@@ -329,9 +328,8 @@ important."
(defun erc-track-remove-from-mode-line ()
"Remove `erc-track-modified-channels' from the mode-line."
- (when (boundp 'mode-line-modes)
- (setq mode-line-modes
- (remove '(t erc-modified-channels-object) mode-line-modes)))
+ (setq mode-line-modes
+ (remove '(t erc-modified-channels-object) mode-line-modes))
(when (consp global-mode-string)
(setq global-mode-string
(delq 'erc-modified-channels-object global-mode-string))))
@@ -341,12 +339,10 @@ important."
See `erc-track-position-in-mode-line' for possible values."
;; CVS Emacs has a new format string, and global-mode-string
;; is very far to the right.
- (cond ((and (eq position 'before-modes)
- (boundp 'mode-line-modes))
+ (cond ((eq position 'before-modes)
(add-to-list 'mode-line-modes
'(t erc-modified-channels-object)))
- ((and (eq position 'after-modes)
- (boundp 'mode-line-modes))
+ ((eq position 'after-modes)
(add-to-list 'mode-line-modes
'(t erc-modified-channels-object) t))
((eq position t)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 3033122437a..e35ae0cfd87 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -57,12 +57,14 @@
(load "erc-loaddefs" nil t)
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(require 'font-lock)
+(require 'format-spec)
(require 'pp)
(require 'thingatpt)
(require 'auth-source)
-(require 'erc-compat)
+(require 'time-date)
+(require 'iso8601)
(eval-when-compile (require 'subr-x))
(defvar erc-official-location
@@ -875,8 +877,8 @@ See `erc-server-flood-margin' for other flood-related parameters.")
;; Script parameters
(defcustom erc-startup-file-list
- (list (concat erc-user-emacs-directory ".ercrc.el")
- (concat erc-user-emacs-directory ".ercrc")
+ (list (concat user-emacs-directory ".ercrc.el")
+ (concat user-emacs-directory ".ercrc")
"~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc")
"List of files to try for a startup script.
The first existent and readable one will get executed.
@@ -1212,7 +1214,7 @@ which the local user typed."
:group 'erc-faces)
(defface erc-header-line
- '((t :foreground "grey20" :background "grey90"))
+ '((t :inherit header-line))
"ERC face used for the header line.
This will only be used if `erc-header-line-face-method' is non-nil."
@@ -1304,7 +1306,7 @@ Example:
(enable (intern (format "erc-%s-enable" (downcase sn))))
(disable (intern (format "erc-%s-disable" (downcase sn)))))
`(progn
- (erc-define-minor-mode
+ (define-minor-mode
,mode
,(format "Toggle ERC %S mode.
With a prefix argument ARG, enable %s if ARG is positive,
@@ -1487,8 +1489,7 @@ Defaults to the server buffer."
(define-derived-mode erc-mode fundamental-mode "ERC"
"Major mode for Emacs IRC."
(setq local-abbrev-table erc-mode-abbrev-table)
- (when (boundp 'next-line-add-newlines)
- (set (make-local-variable 'next-line-add-newlines) nil))
+ (set (make-local-variable 'next-line-add-newlines) nil)
(setq line-move-ignore-invisible t)
(set (make-local-variable 'paragraph-separate)
(concat "\C-l\\|\\(^" (regexp-quote (erc-prompt)) "\\)"))
@@ -1499,7 +1500,7 @@ Defaults to the server buffer."
;; activation
-(defconst erc-default-server "irc.freenode.net"
+(defconst erc-default-server "chat.freenode.net"
"IRC server to use if it cannot be detected otherwise.")
(defconst erc-default-port 6667
@@ -1606,33 +1607,47 @@ symbol, it may have these values:
(defun erc-generate-new-buffer-name (server port target)
"Create a new buffer name based on the arguments."
(when (numberp port) (setq port (number-to-string port)))
- (let ((buf-name (or target
- (or (let ((name (concat server ":" port)))
- (when (> (length name) 1)
- name))
- ;; This fallback should in fact never happen
- "*erc-server-buffer*")))
- buffer-name)
+ (let* ((buf-name (or target
+ (let ((name (concat server ":" port)))
+ (when (> (length name) 1)
+ name))
+ ;; This fallback should in fact never happen.
+ "*erc-server-buffer*"))
+ (full-buf-name (concat buf-name "/" server))
+ (dup-buf-name (buffer-name (car (erc-channel-list nil))))
+ buffer-name)
;; Reuse existing buffers, but not if the buffer is a connected server
;; buffer and not if its associated with a different server than the
;; current ERC buffer.
- ;; if buf-name is taken by a different connection (or by something !erc)
- ;; then see if "buf-name/server" meets the same criteria
- (dolist (candidate (list buf-name (concat buf-name "/" server)))
- (if (and (not buffer-name)
- erc-reuse-buffers
- (or (not (get-buffer candidate))
- (or target
- (with-current-buffer (get-buffer candidate)
- (and (erc-server-buffer-p)
- (not (erc-server-process-alive)))))
- (with-current-buffer (get-buffer candidate)
- (and (string= erc-session-server server)
- (erc-port-equal erc-session-port port)))))
- (setq buffer-name candidate)))
- ;; if buffer-name is unset, neither candidate worked out for us,
+ ;; If buf-name is taken by a different connection (or by something !erc)
+ ;; then see if "buf-name/server" meets the same criteria.
+ (if (and dup-buf-name (string-match-p (concat buf-name "/") dup-buf-name))
+ (setq buffer-name full-buf-name) ; ERC buffer with full name already exists.
+ (dolist (candidate (list buf-name full-buf-name))
+ (if (and (not buffer-name)
+ erc-reuse-buffers
+ (or (not (get-buffer candidate))
+ ;; Looking for a server buffer, so there's no target.
+ (and (not target)
+ (with-current-buffer (get-buffer candidate)
+ (and (erc-server-buffer-p)
+ (not (erc-server-process-alive)))))
+ ;; Channel buffer; check that it's from the right server.
+ (and target
+ (with-current-buffer (get-buffer candidate)
+ (and (string= erc-session-server server)
+ (erc-port-equal erc-session-port port))))))
+ (setq buffer-name candidate)
+ (when (and (not buffer-name) (get-buffer buf-name) erc-reuse-buffers)
+ ;; A new buffer will be created with the name buf-name/server, rename
+ ;; the existing name-duplicated buffer with the same format as well.
+ (with-current-buffer (get-buffer buf-name)
+ (when (derived-mode-p 'erc-mode) ; ensure it's an erc buffer
+ (rename-buffer
+ (concat buf-name "/" (or erc-session-server erc-server-announced-name)))))))))
+ ;; If buffer-name is unset, neither candidate worked out for us,
;; fallback to the old <N> uniquification method:
- (or buffer-name (generate-new-buffer-name (concat buf-name "/" server)))))
+ (or buffer-name (generate-new-buffer-name full-buf-name))))
(defun erc-get-buffer-create (server port target)
"Create a new buffer based on the arguments."
@@ -1858,7 +1873,7 @@ buffer rather than a server buffer.")
;; modify `transforms' to specify what needs to be changed
;; each item is in the format '(old . new)
(let ((transforms '((pcomplete . completion))))
- (erc-delete-dups
+ (delete-dups
(mapcar (lambda (m) (or (cdr (assoc m transforms)) m))
mods))))
@@ -2229,7 +2244,7 @@ Non-interactively, it takes the keyword arguments
That is, if called with
- (erc :server \"irc.freenode.net\" :full-name \"Harry S Truman\")
+ (erc :server \"chat.freenode.net\" :full-name \"Harry S Truman\")
then the server and full-name will be set to those values, whereas
`erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will
@@ -2311,7 +2326,7 @@ and appears in face `erc-input-face' in the buffer."
(setq result (concat result network-name
" << " line "\n")))
result)
- (erc-propertize
+ (propertize
(concat network-name " >> " string
(if (/= ?\n
(aref string
@@ -2334,7 +2349,7 @@ If ARG is non-nil, show the *erc-protocol* buffer."
(interactive "P")
(let* ((buf (get-buffer-create "*erc-protocol*")))
(with-current-buffer buf
- (erc-view-mode-enter)
+ (view-mode-enter)
(when (null (current-local-map))
(let ((inhibit-read-only t))
(insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n"))
@@ -2672,7 +2687,7 @@ displayed hostnames."
otherwise `erc-server-announced-name'. SERVER is matched against
`erc-common-server-suffixes'."
(when server
- (or (cdar (erc-remove-if-not
+ (or (cdar (cl-remove-if-not
(lambda (net) (string-match (car net) server))
erc-common-server-suffixes))
erc-server-announced-name)))
@@ -2768,7 +2783,7 @@ See also `erc-server-send'."
(defun erc-get-arglist (fun)
"Return the argument list of a function without the parens."
- (let ((arglist (format "%S" (erc-function-arglist fun))))
+ (let ((arglist (format "%S" (help-function-arglist fun))))
(if (string-match "\\`(\\(.*\\))\\'" arglist)
(match-string 1 arglist)
arglist)))
@@ -2903,6 +2918,44 @@ therefore has to contain the command itself as well."
(erc-server-send (substring line 1))
t)
+(defvar erc--read-time-period-history nil)
+
+(defun erc--read-time-period (prompt)
+ "Read a time period on the \"2h\" format.
+If there's no letter spec, the input is interpreted as a number of seconds.
+
+If input is blank, this function returns nil. Otherwise it
+returns the time spec converted to a number of seconds."
+ (let ((period (string-trim
+ (read-string prompt nil 'erc--read-time-period-history))))
+ (cond
+ ;; Blank input.
+ ((zerop (length period))
+ nil)
+ ;; All-number -- interpret as seconds.
+ ((string-match-p "\\`[0-9]+\\'" period)
+ (string-to-number period))
+ ;; Parse as a time spec.
+ (t
+ (let ((time (condition-case nil
+ (iso8601-parse-duration
+ (concat (cond
+ ((string-match-p "\\`P" (upcase period))
+ ;; Somebody typed in a full ISO8601 period.
+ (upcase period))
+ ((string-match-p "[YD]" (upcase period))
+ ;; If we have a year/day element,
+ ;; we have a full spec.
+ "P")
+ (t
+ ;; Otherwise it's just a sub-day spec.
+ "PT"))
+ (upcase period)))
+ (wrong-type-argument nil))))
+ (unless time
+ (user-error "%s is not a valid time period" period))
+ (decoded-time-period time))))))
+
(defun erc-cmd-IGNORE (&optional user)
"Ignore USER. This should be a regexp matching nick!user@host.
If no USER argument is specified, list the contents of `erc-ignore-list'."
@@ -2912,10 +2965,18 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(y-or-n-p (format "Use regexp-quoted form (%s) instead? "
quoted)))
(setq user quoted))
- (erc-display-line
- (erc-make-notice (format "Now ignoring %s" user))
- 'active)
- (erc-with-server-buffer (add-to-list 'erc-ignore-list user)))
+ (let ((timeout
+ (erc--read-time-period
+ "Add a timeout? (Blank for no, or a time spec like 2h): "))
+ (buffer (current-buffer)))
+ (when timeout
+ (run-at-time timeout nil
+ (lambda ()
+ (erc--unignore-user user buffer))))
+ (erc-display-line
+ (erc-make-notice (format "Now ignoring %s" user))
+ 'active)
+ (erc-with-server-buffer (add-to-list 'erc-ignore-list user))))
(if (null (erc-with-server-buffer erc-ignore-list))
(erc-display-line (erc-make-notice "Ignore list is empty") 'active)
(erc-display-line (erc-make-notice "Ignore list:") 'active)
@@ -2939,12 +3000,17 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(erc-make-notice (format "%s is not currently ignored!" user))
'active)))
(when ignored-nick
+ (erc--unignore-user user (current-buffer))))
+ t)
+
+(defun erc--unignore-user (user buffer)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
(erc-display-line
(erc-make-notice (format "No longer ignoring %s" user))
'active)
(erc-with-server-buffer
- (setq erc-ignore-list (delete ignored-nick erc-ignore-list)))))
- t)
+ (setq erc-ignore-list (delete user erc-ignore-list))))))
(defun erc-cmd-CLEAR ()
"Clear the window content."
@@ -3097,16 +3163,18 @@ were most recently invited. See also `invitation'."
(setq chnl (erc-ensure-channel-name channel)))
(when chnl
;; Prevent double joining of same channel on same server.
- (let ((joined-channels
- (mapcar #'(lambda (chanbuf)
- (with-current-buffer chanbuf (erc-default-target)))
- (erc-channel-list erc-server-process))))
- (if (erc-member-ignore-case chnl joined-channels)
- (switch-to-buffer (car (erc-member-ignore-case chnl
- joined-channels)))
- (let ((server (with-current-buffer (process-buffer erc-server-process)
- (or erc-session-server erc-server-announced-name))))
- (erc-server-join-channel server chnl key))))))
+ (let* ((joined-channels
+ (mapcar #'(lambda (chanbuf)
+ (with-current-buffer chanbuf (erc-default-target)))
+ (erc-channel-list erc-server-process)))
+ (server (with-current-buffer (process-buffer erc-server-process)
+ (or erc-session-server erc-server-announced-name)))
+ (chnl-name (car (erc-member-ignore-case chnl joined-channels))))
+ (if chnl-name
+ (switch-to-buffer (if (get-buffer chnl-name)
+ chnl-name
+ (concat chnl-name "/" server)))
+ (erc-server-join-channel server chnl key)))))
t)
(defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN)
@@ -3502,7 +3570,7 @@ If S is non-nil, it will be used as the quit reason."
If S is non-nil, it will be used as the quit reason."
(or s
(if (fboundp 'yow)
- (erc-replace-regexp-in-string "\n" "" (yow))
+ (replace-regexp-in-string "\n" "" (yow))
(erc-quit/part-reason-default))))
(make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4")
@@ -3529,7 +3597,7 @@ If S is non-nil, it will be used as the part reason."
If S is non-nil, it will be used as the quit reason."
(or s
(if (fboundp 'yow)
- (erc-replace-regexp-in-string "\n" "" (yow))
+ (replace-regexp-in-string "\n" "" (yow))
(erc-quit/part-reason-default))))
(make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4")
@@ -3656,8 +3724,9 @@ the message given by REASON."
x-toolkit-scroll-bars)))
"")
(if (featurep 'multi-tty) ", multi-tty" ""))
- (if erc-emacs-build-time
- (concat " of " erc-emacs-build-time)
+ (if emacs-build-time
+ (concat " of " (format-time-string
+ "%Y-%m-%d" emacs-build-time))
"")))
t)
@@ -3945,13 +4014,13 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
;; Do not extend the text properties when typing at the end
;; of the prompt, but stuff typed in front of the prompt
;; shall remain part of the prompt.
- (setq prompt (erc-propertize prompt
- 'start-open t ; XEmacs
- 'rear-nonsticky t ; Emacs
- 'erc-prompt t
- 'field t
- 'front-sticky t
- 'read-only t))
+ (setq prompt (propertize prompt
+ 'start-open t ; XEmacs
+ 'rear-nonsticky t ; Emacs
+ 'erc-prompt t
+ 'field t
+ 'front-sticky t
+ 'read-only t))
(erc-put-text-property 0 (1- (length prompt))
'font-lock-face (or face 'erc-prompt-face)
prompt)
@@ -4003,7 +4072,8 @@ If `point' is at the beginning of a channel name, use that as default."
(table (when (erc-server-buffer-live-p)
(set-buffer (process-buffer erc-server-process))
erc-channel-list)))
- (completing-read "Join channel: " table nil nil nil nil chnl))
+ (completing-read (format-prompt "Join channel" chnl)
+ table nil nil nil nil chnl))
(when (or current-prefix-arg erc-prompt-for-channel-key)
(read-from-minibuffer "Channel key (RET for none): " nil))))
(erc-cmd-JOIN channel (when (>= (length key) 1) key)))
@@ -4334,15 +4404,15 @@ See also `erc-format-nick-function'."
(defun erc-get-user-mode-prefix (user)
(when user
(cond ((erc-channel-user-owner-p user)
- (erc-propertize "~" 'help-echo "owner"))
+ (propertize "~" 'help-echo "owner"))
((erc-channel-user-admin-p user)
- (erc-propertize "&" 'help-echo "admin"))
+ (propertize "&" 'help-echo "admin"))
((erc-channel-user-op-p user)
- (erc-propertize "@" 'help-echo "operator"))
+ (propertize "@" 'help-echo "operator"))
((erc-channel-user-halfop-p user)
- (erc-propertize "%" 'help-echo "half-op"))
+ (propertize "%" 'help-echo "half-op"))
((erc-channel-user-voice-p user)
- (erc-propertize "+" 'help-echo "voice"))
+ (propertize "+" 'help-echo "voice"))
(t ""))))
(defun erc-format-@nick (&optional user _channel-data)
@@ -4353,7 +4423,7 @@ prefix. Use CHANNEL-DATA to determine op and voice status. See
also `erc-format-nick-function'."
(when user
(let ((nick (erc-server-user-nickname user)))
- (concat (erc-propertize
+ (concat (propertize
(erc-get-user-mode-prefix nick)
'font-lock-face 'erc-nick-prefix-face)
nick))))
@@ -4366,12 +4436,12 @@ also `erc-format-nick-function'."
(nick (erc-current-nick))
(mode (erc-get-user-mode-prefix nick)))
(concat
- (erc-propertize open 'font-lock-face 'erc-default-face)
- (erc-propertize mode 'font-lock-face 'erc-my-nick-prefix-face)
- (erc-propertize nick 'font-lock-face 'erc-my-nick-face)
- (erc-propertize close 'font-lock-face 'erc-default-face)))
+ (propertize open 'font-lock-face 'erc-default-face)
+ (propertize mode 'font-lock-face 'erc-my-nick-prefix-face)
+ (propertize nick 'font-lock-face 'erc-my-nick-face)
+ (propertize close 'font-lock-face 'erc-default-face)))
(let ((prefix "> "))
- (erc-propertize prefix 'font-lock-face 'erc-default-face))))
+ (propertize prefix 'font-lock-face 'erc-default-face))))
(defun erc-echo-notice-in-default-buffer (s parsed buffer _sender)
"Echos a private notice in the default buffer, namely the
@@ -4504,7 +4574,7 @@ See also: `erc-echo-notice-in-user-buffers',
((string-match "^-" mode)
;; Remove the unbanned masks from the ban list
(setq erc-channel-banlist
- (erc-delete-if
+ (cl-delete-if
#'(lambda (y)
(member (upcase (cdr y))
(mapcar #'upcase
@@ -4525,7 +4595,7 @@ See also: `erc-echo-notice-in-user-buffers',
"Group LIST into sublists of length N."
(cond ((null list) nil)
((null (nthcdr n list)) (list list))
- (t (cons (erc-subseq list 0 n) (erc-group-list (nthcdr n list) n)))))
+ (t (cons (cl-subseq list 0 n) (erc-group-list (nthcdr n list) n)))))
;;; MOTD numreplies
@@ -5402,6 +5472,10 @@ submitted line to be intentional."
(time-less-p erc-accidental-paste-threshold-seconds
(time-subtract now erc-last-input-time)))
(save-restriction
+ ;; If there's an abbrev at the end of the line, expand it.
+ (when (and abbrev-mode
+ (eolp))
+ (expand-abbrev))
(widen)
(if (< (point) (erc-beg-of-input-line))
(erc-error "Point is not in the input area")
@@ -6114,8 +6188,7 @@ non-nil value is found.
output (apply #'format format-args))
;; Change all "1 units" to "1 unit".
(while (string-match "\\([^0-9]\\|^\\)1 \\S-+\\(s\\)" output)
- (setq output (erc-replace-match-subexpression-in-string
- "" output (match-string 2 output) 2 (match-beginning 2))))
+ (setq output (replace-match "" nil nil output 2)))
output))
@@ -6391,17 +6464,16 @@ if `erc-away' is non-nil."
(defun erc-update-mode-line-buffer (buffer)
"Update the mode line in a single ERC buffer BUFFER."
(with-current-buffer buffer
- (let ((spec (format-spec-make
- ?a (erc-format-away-status)
- ?l (erc-format-lag-time)
- ?m (erc-format-channel-modes)
- ?n (or (erc-current-nick) "")
- ?N (erc-format-network)
- ?o (or (erc-controls-strip erc-channel-topic) "")
- ?p (erc-port-to-string erc-session-port)
- ?s (erc-format-target-and/or-server)
- ?S (erc-format-target-and/or-network)
- ?t (erc-format-target)))
+ (let ((spec `((?a . ,(erc-format-away-status))
+ (?l . ,(erc-format-lag-time))
+ (?m . ,(erc-format-channel-modes))
+ (?n . ,(or (erc-current-nick) ""))
+ (?N . ,(erc-format-network))
+ (?o . ,(or (erc-controls-strip erc-channel-topic) ""))
+ (?p . ,(erc-port-to-string erc-session-port))
+ (?s . ,(erc-format-target-and/or-server))
+ (?S . ,(erc-format-target-and/or-network))
+ (?t . ,(erc-format-target))))
(process-status (cond ((and (erc-server-process-alive)
(not erc-server-connected))
":connecting")
@@ -6434,16 +6506,16 @@ if `erc-away' is non-nil."
(fill-region (point-min) (point-max))
(buffer-string))))
(setq header-line-format
- (erc-replace-regexp-in-string
+ (replace-regexp-in-string
"%"
"%%"
(if face
- (erc-propertize header 'help-echo help-echo
- 'face face)
- (erc-propertize header 'help-echo help-echo))))))
+ (propertize header 'help-echo help-echo
+ 'face face)
+ (propertize header 'help-echo help-echo))))))
(t (setq header-line-format
(if face
- (erc-propertize header 'face face)
+ (propertize header 'face face)
header)))))))
(force-mode-line-update)))
@@ -6710,7 +6782,7 @@ functions."
nick user host channel
(if (not (string= reason ""))
(format ": %s"
- (erc-replace-regexp-in-string "%" "%%" reason))
+ (replace-regexp-in-string "%" "%%" reason))
"")))))
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
index 6cfc89cce62..e54eab50fc9 100644
--- a/lisp/eshell/em-basic.el
+++ b/lisp/eshell/em-basic.el
@@ -90,11 +90,10 @@ or `eshell-printn' for display."
(car args))
(t
(mapcar
- (function
- (lambda (arg)
- (if (stringp arg)
- (set-text-properties 0 (length arg) nil arg))
- arg))
+ (lambda (arg)
+ (if (stringp arg)
+ (set-text-properties 0 (length arg) nil arg))
+ arg)
args)))))
(if output-newline
(cond
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 48c99acac33..53a0cda354e 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -116,6 +116,9 @@ is non-nil."
(defcustom eshell-command-completions-alist
'(("acroread" . "\\.pdf\\'")
("xpdf" . "\\.pdf\\'")
+ ("gunzip" . "\\.t?gz\\'")
+ ("bunzip2" . "\\.t?bz2\\'")
+ ("unxz" . "\\.t?xz\\'")
("ar" . "\\.[ao]\\'")
("gcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
("g++" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
@@ -207,9 +210,8 @@ to writing a completion function."
:group 'eshell-cmpl)
(defcustom eshell-command-completion-function
- (function
- (lambda ()
- (pcomplete-here (eshell-complete-commands-list))))
+ (lambda ()
+ (pcomplete-here (eshell-complete-commands-list)))
(eshell-cmpl--custom-variable-docstring 'pcomplete-command-completion-function)
:type (get 'pcomplete-command-completion-function 'custom-type)
:group 'eshell-cmpl)
@@ -221,12 +223,11 @@ to writing a completion function."
:group 'eshell-cmpl)
(defcustom eshell-default-completion-function
- (function
- (lambda ()
- (while (pcomplete-here
- (pcomplete-dirs-or-entries
- (cdr (assoc (funcall eshell-cmpl-command-name-function)
- eshell-command-completions-alist)))))))
+ (lambda ()
+ (while (pcomplete-here
+ (pcomplete-dirs-or-entries
+ (cdr (assoc (funcall eshell-cmpl-command-name-function)
+ eshell-command-completions-alist))))))
(eshell-cmpl--custom-variable-docstring 'pcomplete-default-completion-function)
:type (get 'pcomplete-default-completion-function 'custom-type)
:group 'eshell-cmpl)
@@ -244,6 +245,26 @@ to writing a completion function."
(let ((completion-at-point-functions '(elisp-completion-at-point)))
(completion-at-point)))
+(defvar eshell-cmpl-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?i)] #'completion-at-point)
+ ;; jww (1999-10-19): Will this work on anything but X?
+ (define-key map [backtab] #'pcomplete-reverse)
+ (define-key map [(meta ??)] #'completion-help-at-point)
+ (define-key map [(meta control ?i)] #'eshell-complete-lisp-symbol)
+ ;; C-c prefix:
+ (define-key map (kbd "C-c M-h") #'eshell-completion-help)
+ (define-key map (kbd "C-c TAB") #'pcomplete-expand-and-complete)
+ (define-key map (kbd "C-c C-i") #'pcomplete-expand-and-complete)
+ (define-key map (kbd "C-c SPC") #'pcomplete-expand)
+ map))
+
+(define-minor-mode eshell-cmpl-mode
+ "Minor mode that provides a keymap when `eshell-cmpl' active.
+
+\\{eshell-cmpl-mode-map}"
+ :keymap eshell-cmpl-mode-map)
+
(defun eshell-cmpl-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the completions module."
(set (make-local-variable 'pcomplete-command-completion-function)
@@ -285,28 +306,14 @@ to writing a completion function."
;; load-hooks for any other extension modules have been run, which
;; is true at the time `eshell-mode-hook' is run
(add-hook 'eshell-mode-hook
- (function
- (lambda ()
- (set (make-local-variable 'comint-file-name-quote-list)
- eshell-special-chars-outside-quoting)))
+ (lambda ()
+ (set (make-local-variable 'comint-file-name-quote-list)
+ eshell-special-chars-outside-quoting))
nil t)
(add-hook 'pcomplete-quote-arg-hook #'eshell-quote-backslash nil t)
- ;;(define-key eshell-mode-map [(meta tab)] 'eshell-complete-lisp-symbol) ; Redundant
- (define-key eshell-mode-map [(meta control ?i)] 'eshell-complete-lisp-symbol)
- (define-key eshell-command-map [(meta ?h)] 'eshell-completion-help)
- (define-key eshell-command-map [tab] 'pcomplete-expand-and-complete)
- (define-key eshell-command-map [(control ?i)]
- 'pcomplete-expand-and-complete)
- (define-key eshell-command-map [space] 'pcomplete-expand)
- (define-key eshell-command-map [? ] 'pcomplete-expand)
- ;;(define-key eshell-mode-map [tab] 'completion-at-point) ;Redundant!
- (define-key eshell-mode-map [(control ?i)] 'completion-at-point)
(add-hook 'completion-at-point-functions
#'pcomplete-completions-at-point nil t)
- ;; jww (1999-10-19): Will this work on anything but X?
- (define-key eshell-mode-map
- (if (featurep 'xemacs) [iso-left-tab] [backtab]) 'pcomplete-reverse)
- (define-key eshell-mode-map [(meta ??)] 'completion-help-at-point))
+ (eshell-cmpl-mode))
(defun eshell-completion-command-name ()
"Return the command name, possibly sans globbing."
@@ -381,19 +388,18 @@ to writing a completion function."
(nconc args (list ""))
(nconc posns (list (point))))
(cons (mapcar
- (function
- (lambda (arg)
- (let ((val
- (if (listp arg)
- (let ((result
- (eshell-do-eval
- (list 'eshell-commands arg) t)))
- (cl-assert (eq (car result) 'quote))
- (cadr result))
- arg)))
- (if (numberp val)
- (setq val (number-to-string val)))
- (or val ""))))
+ (lambda (arg)
+ (let ((val
+ (if (listp arg)
+ (let ((result
+ (eshell-do-eval
+ (list 'eshell-commands arg) t)))
+ (cl-assert (eq (car result) 'quote))
+ (cadr result))
+ arg)))
+ (if (numberp val)
+ (setq val (number-to-string val)))
+ (or val "")))
args)
posns)))
@@ -444,9 +450,8 @@ to writing a completion function."
(eshell-alias-completions filename))
(eshell-winnow-list
(mapcar
- (function
- (lambda (name)
- (substring name 7)))
+ (lambda (name)
+ (substring name 7))
(all-completions (concat "eshell/" filename)
obarray #'functionp))
nil '(eshell-find-alias-function))
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index 1949e5dc8fc..b4ed3794add 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -168,6 +168,9 @@ Thus, this does not include the current directory.")
(defvar eshell-last-dir-ring nil
"The last directory that Eshell was in.")
+(defconst eshell-inside-emacs (format "%s,eshell" emacs-version)
+ "Value for the `INSIDE_EMACS' environment variable.")
+
;;; Functions:
(defun eshell-dirs-initialize () ;Called from `eshell-mode' via intern-soft!
@@ -191,6 +194,8 @@ Thus, this does not include the current directory.")
(unless (ring-empty-p eshell-last-dir-ring)
(expand-file-name
(ring-ref eshell-last-dir-ring 0))))
+ t)
+ ("INSIDE_EMACS" eshell-inside-emacs
t))))
(when eshell-cd-on-directory
@@ -284,9 +289,8 @@ Thus, this does not include the current directory.")
(eshell-read-user-names)
(pcomplete-uniquify-list
(mapcar
- (function
- (lambda (user)
- (file-name-as-directory (cdr user))))
+ (lambda (user)
+ (file-name-as-directory (cdr user)))
eshell-user-names)))))))
(defun eshell/pwd (&rest _args)
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 43483dcd50e..a32a6abe29c 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -232,8 +232,6 @@ resulting regular expression."
(regexp-quote (substring pattern matched-in-pattern))
"\\'")))
-(defvar ange-cache) ; XEmacs? See esh-util
-
(defun eshell-extended-glob (glob)
"Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY.
This function almost fully supports zsh style filename generation
@@ -252,7 +250,7 @@ the form:
(INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))"
(let ((paths (eshell-split-path glob))
- eshell-glob-matches message-shown ange-cache)
+ eshell-glob-matches message-shown)
(unwind-protect
(if (and (cdr paths)
(file-name-absolute-p (car paths)))
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 73742a361da..c27e4503767 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -75,17 +75,14 @@
(defcustom eshell-hist-load-hook nil
"A list of functions to call when loading `eshell-hist'."
:version "24.1" ; removed eshell-hist-initialize
- :type 'hook
- :group 'eshell-hist)
+ :type 'hook)
(defcustom eshell-hist-unload-hook
(list
- (function
- (lambda ()
- (remove-hook 'kill-emacs-hook 'eshell-save-some-history))))
+ (lambda ()
+ (remove-hook 'kill-emacs-hook 'eshell-save-some-history)))
"A hook that gets run when `eshell-hist' is unloaded."
- :type 'hook
- :group 'eshell-hist)
+ :type 'hook)
(defcustom eshell-history-file-name
(expand-file-name "history" eshell-directory-name)
@@ -93,20 +90,17 @@
See also `eshell-read-history' and `eshell-write-history'.
If it is nil, Eshell will use the value of HISTFILE."
:type '(choice (const :tag "Use HISTFILE" nil)
- file)
- :group 'eshell-hist)
+ file))
(defcustom eshell-history-size 128
"Size of the input history ring. If nil, use envvar HISTSIZE."
:type '(choice (const :tag "Use HISTSIZE" nil)
- integer)
- :group 'eshell-hist)
+ integer))
(defcustom eshell-hist-ignoredups nil
"If non-nil, don't add input matching the last on the input ring.
This mirrors the optional behavior of bash."
- :type 'boolean
- :group 'eshell-hist)
+ :type 'boolean)
(defcustom eshell-save-history-on-exit t
"Determine if history should be automatically saved.
@@ -118,8 +112,7 @@ If set to `ask', ask if any Eshell buffers are open at exit time.
If set to t, history will always be saved, silently."
:type '(choice (const :tag "Never" nil)
(const :tag "Ask" ask)
- (const :tag "Always save" t))
- :group 'eshell-hist)
+ (const :tag "Always save" t)))
(defcustom eshell-input-filter 'eshell-input-filter-default
"Predicate for filtering additions to input history.
@@ -128,8 +121,7 @@ the input history list. Default is to save anything that isn't all
whitespace."
:type '(radio (function-item eshell-input-filter-default)
(function-item eshell-input-filter-initial-space)
- (function :tag "Other function"))
- :group 'eshell-hist)
+ (function :tag "Other function")))
(put 'eshell-input-filter 'risky-local-variable t)
@@ -138,31 +130,26 @@ whitespace."
Otherwise, typing <M-p> and <M-n> will always go to the next history
element, regardless of any text on the command line. In that case,
<C-c M-r> and <C-c M-s> still offer that functionality."
- :type 'boolean
- :group 'eshell-hist)
+ :type 'boolean)
(defcustom eshell-hist-move-to-end t
"If non-nil, move to the end of the buffer before cycling history."
- :type 'boolean
- :group 'eshell-hist)
+ :type 'boolean)
(defcustom eshell-hist-event-designator
"^!\\(!\\|-?[0-9]+\\|\\??[^:^$%*?]+\\??\\|#\\)"
"The regexp used to identifier history event designators."
- :type 'regexp
- :group 'eshell-hist)
+ :type 'regexp)
(defcustom eshell-hist-word-designator
"^:?\\([0-9]+\\|[$^%*]\\)?\\(-[0-9]*\\|[$^%*]\\)?"
"The regexp used to identify history word designators."
- :type 'regexp
- :group 'eshell-hist)
+ :type 'regexp)
(defcustom eshell-hist-modifier
"^\\(:\\([hretpqx&g]\\|s/\\([^/]*\\)/\\([^/]*\\)/\\)\\)*"
"The regexp used to identity history modifiers."
- :type 'regexp
- :group 'eshell-hist)
+ :type 'regexp)
(defcustom eshell-hist-rebind-keys-alist
'(([(control ?p)] . eshell-previous-input)
@@ -180,8 +167,7 @@ element, regardless of any text on the command line. In that case,
"History keys to bind differently if point is in input text."
:type '(repeat (cons (vector :tag "Keys to bind"
(repeat :inline t sexp))
- (function :tag "Command")))
- :group 'eshell-hist)
+ (function :tag "Command"))))
;;; Internal Variables:
@@ -202,6 +188,32 @@ element, regardless of any text on the command line. In that case,
map)
"Keymap used in isearch in Eshell.")
+(defvar eshell-hist-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [up] #'eshell-previous-matching-input-from-input)
+ (define-key map [down] #'eshell-next-matching-input-from-input)
+ (define-key map [(control up)] #'eshell-previous-input)
+ (define-key map [(control down)] #'eshell-next-input)
+ (define-key map [(meta ?r)] #'eshell-previous-matching-input)
+ (define-key map [(meta ?s)] #'eshell-next-matching-input)
+ (define-key map (kbd "C-c M-r") #'eshell-previous-matching-input-from-input)
+ (define-key map (kbd "C-c M-s") #'eshell-next-matching-input-from-input)
+ ;; FIXME: Relies on `eshell-hist-match-partial' being set _before_
+ ;; em-hist is loaded and won't respect changes.
+ (if eshell-hist-match-partial
+ (progn
+ (define-key map [(meta ?p)] 'eshell-previous-matching-input-from-input)
+ (define-key map [(meta ?n)] 'eshell-next-matching-input-from-input)
+ (define-key map (kbd "C-c M-p") #'eshell-previous-input)
+ (define-key map (kbd "C-c M-n") #'eshell-next-input))
+ (define-key map [(meta ?p)] #'eshell-previous-input)
+ (define-key map [(meta ?n)] #'eshell-next-input)
+ (define-key map (kbd "C-c M-p") #'eshell-previous-matching-input-from-input)
+ (define-key map (kbd "C-c M-n") #'eshell-next-matching-input-from-input))
+ (define-key map (kbd "C-c C-l") #'eshell-list-history)
+ (define-key map (kbd "C-c C-x") #'eshell-get-next-from-history)
+ map))
+
(defvar eshell-rebind-keys-alist)
;;; Functions:
@@ -216,6 +228,12 @@ Returns non-nil if INPUT is blank."
Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(not (string-match-p "\\`\\s-+" input)))
+(define-minor-mode eshell-hist-mode
+ "Minor mode for the eshell-hist module.
+
+\\{eshell-hist-mode-map}"
+ :keymap eshell-hist-mode-map)
+
(defun eshell-hist-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the history management code for one Eshell buffer."
(when (eshell-using-module 'eshell-cmpl)
@@ -231,41 +249,16 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(set (make-local-variable 'search-invisible) t)
(set (make-local-variable 'search-exit-option) t)
(add-hook 'isearch-mode-hook
- (function
- (lambda ()
- (if (>= (point) eshell-last-output-end)
- (setq overriding-terminal-local-map
- eshell-isearch-map))))
+ (lambda ()
+ (if (>= (point) eshell-last-output-end)
+ (setq overriding-terminal-local-map
+ eshell-isearch-map)))
nil t)
(add-hook 'isearch-mode-end-hook
- (function
- (lambda ()
- (setq overriding-terminal-local-map nil)))
+ (lambda ()
+ (setq overriding-terminal-local-map nil))
nil t))
- (define-key eshell-mode-map [up] 'eshell-previous-matching-input-from-input)
- (define-key eshell-mode-map [down] 'eshell-next-matching-input-from-input)
- (define-key eshell-mode-map [(control up)] 'eshell-previous-input)
- (define-key eshell-mode-map [(control down)] 'eshell-next-input)
- (define-key eshell-mode-map [(meta ?r)] 'eshell-previous-matching-input)
- (define-key eshell-mode-map [(meta ?s)] 'eshell-next-matching-input)
- (define-key eshell-command-map [(meta ?r)]
- 'eshell-previous-matching-input-from-input)
- (define-key eshell-command-map [(meta ?s)]
- 'eshell-next-matching-input-from-input)
- (if eshell-hist-match-partial
- (progn
- (define-key eshell-mode-map [(meta ?p)]
- 'eshell-previous-matching-input-from-input)
- (define-key eshell-mode-map [(meta ?n)]
- 'eshell-next-matching-input-from-input)
- (define-key eshell-command-map [(meta ?p)] 'eshell-previous-input)
- (define-key eshell-command-map [(meta ?n)] 'eshell-next-input))
- (define-key eshell-mode-map [(meta ?p)] 'eshell-previous-input)
- (define-key eshell-mode-map [(meta ?n)] 'eshell-next-input)
- (define-key eshell-command-map [(meta ?p)]
- 'eshell-previous-matching-input-from-input)
- (define-key eshell-command-map [(meta ?n)]
- 'eshell-next-matching-input-from-input)))
+ (eshell-hist-mode))
(make-local-variable 'eshell-history-size)
(or eshell-history-size
@@ -299,11 +292,7 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(add-hook 'kill-emacs-hook #'eshell-save-some-history)
- (make-local-variable 'eshell-input-filter-functions)
- (add-hook 'eshell-input-filter-functions #'eshell-add-to-history nil t)
-
- (define-key eshell-command-map [(control ?l)] 'eshell-list-history)
- (define-key eshell-command-map [(control ?x)] 'eshell-get-next-from-history))
+ (add-hook 'eshell-input-filter-functions #'eshell-add-to-history nil t))
(defun eshell-save-some-history ()
"Save the history for any open Eshell buffers."
@@ -856,7 +845,7 @@ Moves relative to START, or `eshell-history-index'."
(setq prev n
n (mod (+ n motion) len))
;; If we haven't reached a match, step some more.
- (while (and (< n len) (not tried-each-ring-item)
+ (while (and (not tried-each-ring-item)
(not (string-match regexp (eshell-get-history n))))
(setq n (mod (+ n motion) len)
;; If we have gone all the way around in this search.
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 70b3ad611a1..e10be8e6232 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -239,7 +239,6 @@ scope during the evaluation of TEST-SEXP."
(defvar show-recursive)
(defvar show-size)
(defvar sort-method)
-(defvar ange-cache)
(defvar dired-flag)
;;; Functions:
@@ -406,7 +405,7 @@ Sort entries alphabetically across.")
(setq listing-style 'by-columns))
(unless args
(setq args (list ".")))
- (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp) ange-cache)
+ (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp))
(when ignore-pattern
(unless (eshell-using-module 'eshell-glob)
(error (concat "-I option requires that `eshell-glob'"
@@ -632,38 +631,37 @@ In Eshell's implementation of ls, ENTRIES is always reversed."
(if (eq sort-method 'unsorted)
(nreverse entries)
(sort entries
- (function
- (lambda (l r)
- (let ((result
- (cond
- ((eq sort-method 'by-atime)
- (eshell-ls-compare-entries l r 4 'time-less-p))
- ((eq sort-method 'by-mtime)
- (eshell-ls-compare-entries l r 5 'time-less-p))
- ((eq sort-method 'by-ctime)
- (eshell-ls-compare-entries l r 6 'time-less-p))
- ((eq sort-method 'by-size)
- (eshell-ls-compare-entries l r 7 '<))
- ((eq sort-method 'by-extension)
- (let ((lx (file-name-extension
- (directory-file-name (car l))))
- (rx (file-name-extension
- (directory-file-name (car r)))))
- (cond
- ((or (and (not lx) (not rx))
- (equal lx rx))
- (string-lessp (directory-file-name (car l))
- (directory-file-name (car r))))
- ((not lx) t)
- ((not rx) nil)
- (t
- (string-lessp lx rx)))))
- (t
- (string-lessp (directory-file-name (car l))
- (directory-file-name (car r)))))))
- (if reverse-list
- (not result)
- result)))))))
+ (lambda (l r)
+ (let ((result
+ (cond
+ ((eq sort-method 'by-atime)
+ (eshell-ls-compare-entries l r 4 'time-less-p))
+ ((eq sort-method 'by-mtime)
+ (eshell-ls-compare-entries l r 5 'time-less-p))
+ ((eq sort-method 'by-ctime)
+ (eshell-ls-compare-entries l r 6 'time-less-p))
+ ((eq sort-method 'by-size)
+ (eshell-ls-compare-entries l r 7 '<))
+ ((eq sort-method 'by-extension)
+ (let ((lx (file-name-extension
+ (directory-file-name (car l))))
+ (rx (file-name-extension
+ (directory-file-name (car r)))))
+ (cond
+ ((or (and (not lx) (not rx))
+ (equal lx rx))
+ (string-lessp (directory-file-name (car l))
+ (directory-file-name (car r))))
+ ((not lx) t)
+ ((not rx) nil)
+ (t
+ (string-lessp lx rx)))))
+ (t
+ (string-lessp (directory-file-name (car l))
+ (directory-file-name (car r)))))))
+ (if reverse-list
+ (not result)
+ result))))))
(defun eshell-ls-files (files &optional size-width copy-fileinfo)
"Output a list of FILES.
@@ -800,9 +798,8 @@ to use, and each member of which is the width of that column
(width 0)
(widths
(mapcar
- (function
- (lambda (file)
- (+ 2 (length (car file)))))
+ (lambda (file)
+ (+ 2 (length (car file))))
files))
;; must account for the added space...
(max-width (+ (window-width) 2))
@@ -847,9 +844,8 @@ to use, and each member of which is the width of that column
(width 0)
(widths
(mapcar
- (function
- (lambda (file)
- (+ 2 (length (car file)))))
+ (lambda (file)
+ (+ 2 (length (car file))))
files))
(max-width (+ (window-width) 2))
col-widths
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index ee4b28fb3ae..7b9503917c4 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -73,18 +73,18 @@ ordinary strings."
(?p . (eshell-pred-file-type ?p)) ; named pipes
(?@ . (eshell-pred-file-type ?l)) ; symbolic links
(?% . (eshell-pred-file-type ?%)) ; allow user to specify (c def.)
- (?r . (eshell-pred-file-mode 0400)) ; owner-readable
- (?w . (eshell-pred-file-mode 0200)) ; owner-writable
- (?x . (eshell-pred-file-mode 0100)) ; owner-executable
- (?A . (eshell-pred-file-mode 0040)) ; group-readable
- (?I . (eshell-pred-file-mode 0020)) ; group-writable
- (?E . (eshell-pred-file-mode 0010)) ; group-executable
- (?R . (eshell-pred-file-mode 0004)) ; world-readable
- (?W . (eshell-pred-file-mode 0002)) ; world-writable
- (?X . (eshell-pred-file-mode 0001)) ; world-executable
- (?s . (eshell-pred-file-mode 4000)) ; setuid
- (?S . (eshell-pred-file-mode 2000)) ; setgid
- (?t . (eshell-pred-file-mode 1000)) ; sticky bit
+ (?r . (eshell-pred-file-mode #o0400)) ; owner-readable
+ (?w . (eshell-pred-file-mode #o0200)) ; owner-writable
+ (?x . (eshell-pred-file-mode #o0100)) ; owner-executable
+ (?A . (eshell-pred-file-mode #o0040)) ; group-readable
+ (?I . (eshell-pred-file-mode #o0020)) ; group-writable
+ (?E . (eshell-pred-file-mode #o0010)) ; group-executable
+ (?R . (eshell-pred-file-mode #o0004)) ; world-readable
+ (?W . (eshell-pred-file-mode #o0002)) ; world-writable
+ (?X . (eshell-pred-file-mode #o0001)) ; world-executable
+ (?s . (eshell-pred-file-mode #o4000)) ; setuid
+ (?S . (eshell-pred-file-mode #o2000)) ; setgid
+ (?t . (eshell-pred-file-mode #o1000)) ; sticky bit
(?U . #'(lambda (file) ; owned by effective uid
(if (file-exists-p file)
(= (file-attribute-user-id (file-attributes file))
@@ -116,10 +116,9 @@ The format of each entry is
(defcustom eshell-modifier-alist
'((?E . #'(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (eshell-stringify
- (car (eshell-parse-argument str)))))
+ (lambda (str)
+ (eshell-stringify
+ (car (eshell-parse-argument str))))
lst)))
(?L . #'(lambda (lst) (mapcar 'downcase lst)))
(?U . #'(lambda (lst) (mapcar 'upcase lst)))
@@ -229,28 +228,37 @@ FOR LISTS OF ARGUMENTS:
EXAMPLES:
*.c(:o) sorted list of .c files")
+(defvar eshell-pred-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c M-q") #'eshell-display-predicate-help)
+ (define-key map (kbd "C-c M-m") #'eshell-display-modifier-help)
+ map))
+
;;; Functions:
(defun eshell-display-predicate-help ()
(interactive)
(with-electric-help
- (function
- (lambda ()
- (insert eshell-predicate-help-string)))))
+ (lambda ()
+ (insert eshell-predicate-help-string))))
(defun eshell-display-modifier-help ()
(interactive)
(with-electric-help
- (function
- (lambda ()
- (insert eshell-modifier-help-string)))))
+ (lambda ()
+ (insert eshell-modifier-help-string))))
+
+(define-minor-mode eshell-pred-mode
+ "Minor mode for the eshell-pred module.
+
+\\{eshell-pred-mode-map}"
+ :keymap eshell-pred-mode-map)
(defun eshell-pred-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the predicate/modifier code."
(add-hook 'eshell-parse-argument-hook
#'eshell-parse-arg-modifier t t)
- (define-key eshell-command-map [(meta ?q)] 'eshell-display-predicate-help)
- (define-key eshell-command-map [(meta ?m)] 'eshell-display-modifier-help))
+ (eshell-pred-mode))
(defun eshell-apply-modifiers (lst predicates modifiers)
"Apply to LIST a series of PREDICATES and MODIFIERS."
@@ -440,11 +448,9 @@ resultant list of strings."
`(lambda (file)
(let ((attrs (file-attributes file)))
(if attrs
- (,(if (eq qual ?-)
- 'time-less-p
- (if (eq qual ?+)
- '(lambda (a b) (time-less-p b a))
- 'time-equal-p))
+ (,(cond ((eq qual ?-) #'time-less-p)
+ ((eq qual ?+) (lambda (a b) (time-less-p b a)))
+ (#'time-equal-p))
,when (nth ,attr-index attrs)))))))
(defun eshell-pred-file-type (type)
@@ -467,9 +473,9 @@ that `ls -l' will show in the first column of its display."
(defsubst eshell-pred-file-mode (mode)
"Return a test which tests that MODE pertains to the file."
`(lambda (file)
- (let ((modes (file-modes file)))
+ (let ((modes (file-modes file 'nofollow)))
(if modes
- (logand ,mode modes)))))
+ (not (zerop (logand ,mode modes)))))))
(defun eshell-pred-file-links ()
"Return a predicate to test whether a file has a given number of links."
@@ -535,20 +541,20 @@ that `ls -l' will show in the first column of its display."
(if repeat
`(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (let ((i 0))
- (while (setq i (string-match ,match str i))
- (setq str (replace-match ,replace t nil str))))
- str)) lst))
+ (lambda (str)
+ (let ((i 0))
+ (while (setq i (string-match ,match str i))
+ (setq str (replace-match ,replace t nil str))))
+ str)
+ lst))
`(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (if (string-match ,match str)
- (setq str (replace-match ,replace t nil str))
- (error (concat str ": substitution failed")))
- str)) lst)))))
+ (lambda (str)
+ (if (string-match ,match str)
+ (setq str (replace-match ,replace t nil str))
+ (error (concat str ": substitution failed")))
+ str)
+ lst)))))
(defun eshell-include-members (&optional invert-p)
"Include only lisp members matching a regexp."
@@ -589,9 +595,8 @@ that `ls -l' will show in the first column of its display."
(goto-char (1+ end)))
`(lambda (lst)
(mapcar
- (function
- (lambda (str)
- (split-string str ,sep))) lst))))
+ (lambda (str)
+ (split-string str ,sep)) lst))))
(provide 'em-pred)
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index bbf3b94ff44..dcee1e7a981 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -48,10 +48,9 @@ as is common with most shells."
(autoload 'eshell/pwd "em-dirs")
(defcustom eshell-prompt-function
- (function
- (lambda ()
- (concat (abbreviate-file-name (eshell/pwd))
- (if (= (user-uid) 0) " # " " $ "))))
+ (lambda ()
+ (concat (abbreviate-file-name (eshell/pwd))
+ (if (= (user-uid) 0) " # " " $ ")))
"A function that returns the Eshell prompt string.
Make sure to update `eshell-prompt-regexp' so that it will match your
prompt."
@@ -97,8 +96,20 @@ arriving, or after."
:options '(eshell-show-maximum-output)
:group 'eshell-prompt)
+(defvar eshell-prompt-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-n") #'eshell-next-prompt)
+ (define-key map (kbd "C-c C-p") #'eshell-previous-prompt)
+ map))
+
;;; Functions:
+(define-minor-mode eshell-prompt-mode
+ "Minor mode for eshell-prompt module.
+
+\\{eshell-prompt-mode-map}"
+ :keymap eshell-prompt-mode-map)
+
(defun eshell-prompt-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the prompting code."
(unless eshell-non-interactive-p
@@ -110,9 +121,7 @@ arriving, or after."
(set (make-local-variable 'eshell-skip-prompt-function)
'eshell-skip-prompt)
-
- (define-key eshell-command-map [(control ?n)] 'eshell-next-prompt)
- (define-key eshell-command-map [(control ?p)] 'eshell-previous-prompt)))
+ (eshell-prompt-mode)))
(defun eshell-emit-prompt ()
"Emit a prompt if eshell is being used interactively."
diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el
index 85593e45160..7991c631772 100644
--- a/lisp/eshell/em-rebind.el
+++ b/lisp/eshell/em-rebind.el
@@ -114,7 +114,6 @@ This is default behavior of shells like bash."
backward-list
forward-page
backward-page
- forward-point
forward-paragraph
backward-paragraph
backward-prefix-chars
@@ -137,6 +136,11 @@ This is default behavior of shells like bash."
:type '(repeat function)
:group 'eshell-rebind)
+(defvar eshell-rebind-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c M-l") #'eshell-lock-local-map)
+ map))
+
;; Internal Variables:
(defvar eshell-input-keymap)
@@ -145,6 +149,12 @@ This is default behavior of shells like bash."
;;; Functions:
+(define-minor-mode eshell-rebind-mode
+ "Minor mode for the eshell-rebind module.
+
+\\{eshell-rebind-mode-map}"
+ :keymap eshell-rebind-mode-map)
+
(defun eshell-rebind-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the inputting code."
(unless eshell-non-interactive-p
@@ -154,7 +164,7 @@ This is default behavior of shells like bash."
(make-local-variable 'overriding-local-map)
(add-hook 'post-command-hook 'eshell-rebind-input-map nil t)
(set (make-local-variable 'eshell-lock-keymap) nil)
- (define-key eshell-command-map [(meta ?l)] 'eshell-lock-local-map)))
+ (eshell-rebind-mode)))
(defun eshell-lock-local-map (&optional arg)
"Lock or unlock the current local keymap.
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index f173c8db9c1..a28bb1d6415 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -94,10 +94,9 @@ it to get a real sense of how it works."
(defcustom eshell-smart-unload-hook
(list
- (function
- (lambda ()
- (remove-hook 'window-configuration-change-hook
- 'eshell-refresh-windows))))
+ (lambda ()
+ (remove-hook 'window-configuration-change-hook
+ 'eshell-refresh-windows)))
"A hook that gets run when `eshell-smart' is unloaded."
:type 'hook
:group 'eshell-smart)
@@ -186,9 +185,8 @@ The options are `begin', `after' or `end'."
(make-local-variable 'eshell-smart-command-done)
(add-hook 'eshell-post-command-hook
- (function
- (lambda ()
- (setq eshell-smart-command-done t)))
+ (lambda ()
+ (setq eshell-smart-command-done t))
t t)
(unless (eq eshell-review-quick-commands t)
@@ -208,13 +206,12 @@ The options are `begin', `after' or `end'."
"Refresh all visible Eshell buffers."
(let (affected)
(walk-windows
- (function
- (lambda (wind)
- (with-current-buffer (window-buffer wind)
- (if eshell-mode
- (let (window-scroll-functions) ;;FIXME: Why?
- (eshell-smart-scroll-window wind (window-start))
- (setq affected t))))))
+ (lambda (wind)
+ (with-current-buffer (window-buffer wind)
+ (if eshell-mode
+ (let (window-scroll-functions) ;;FIXME: Why?
+ (eshell-smart-scroll-window wind (window-start))
+ (setq affected t)))))
0 frame)
(if affected
(let (window-scroll-functions) ;;FIXME: Why?
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 51699a7aa46..18818648bc4 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -419,9 +419,8 @@ Remove the DIRECTORY(ies), if they are empty.")
(apply 'eshell-shuffle-files
command action
(mapcar
- (function
- (lambda (file)
- (concat source "/" file)))
+ (lambda (file)
+ (concat source "/" file))
(directory-files source))
target func t args)
(when (eq func 'rename-file)
@@ -439,7 +438,10 @@ Remove the DIRECTORY(ies), if they are empty.")
(setq link (file-symlink-p source)))
(progn
(apply 'eshell-funcalln 'make-symbolic-link
- link target args)
+ link target
+ ;; `make-symbolic-link' doesn't have
+ ;; KEEP-TIME; just OK-IF-ALREADY-EXISTS.
+ (list (car args)))
(if (eq func 'rename-file)
(if (and (file-directory-p source)
(not (file-symlink-p source)))
@@ -469,8 +471,6 @@ Remove the DIRECTORY(ies), if they are empty.")
(eshell-parse-command
(format "tar %s %s" tar-args archive) args))))
-(defvar ange-cache) ; XEmacs? See esh-util
-
;; this is to avoid duplicating code...
(defmacro eshell-mvcpln-template (command action func query-var
force-var &optional preserve)
@@ -488,8 +488,7 @@ Remove the DIRECTORY(ies), if they are empty.")
(or (not no-dereference)
(not (file-symlink-p (car args)))))))
(eshell-shorthand-tar-command ,command args)
- (let ((target (car (last args)))
- ange-cache)
+ (let ((target (car (last args))))
(setcdr (last args 2) nil)
(eshell-shuffle-files
,command ,action args target ,func nil
@@ -790,9 +789,9 @@ external command."
;; completions rules for some common UNIX commands
-(defsubst eshell-complete-hostname ()
- "Complete a command that wants a hostname for an argument."
- (pcomplete-here (eshell-read-host-names)))
+(autoload 'pcmpl-unix-complete-hostname "pcmpl-unix")
+(define-obsolete-function-alias 'eshell-complete-hostname
+ #'pcmpl-unix-complete-hostname "28.1")
(defun eshell-complete-host-reference ()
"If there is a host reference, complete it."
@@ -801,26 +800,7 @@ external command."
(when (setq index (string-match "@[a-z.]*\\'" arg))
(setq pcomplete-stub (substring arg (1+ index))
pcomplete-last-completion-raw t)
- (throw 'pcomplete-completions (eshell-read-host-names)))))
-
-(defalias 'pcomplete/ftp 'eshell-complete-hostname)
-(defalias 'pcomplete/ncftp 'eshell-complete-hostname)
-(defalias 'pcomplete/ping 'eshell-complete-hostname)
-(defalias 'pcomplete/rlogin 'eshell-complete-hostname)
-
-(defun pcomplete/telnet ()
- (require 'pcmpl-unix)
- (pcomplete-opt "xl(pcmpl-unix-user-names)")
- (eshell-complete-hostname))
-
-(defun pcomplete/rsh ()
- "Complete `rsh', which, after the user and hostname, is like xargs."
- (require 'pcmpl-unix)
- (pcomplete-opt "l(pcmpl-unix-user-names)")
- (eshell-complete-hostname)
- (pcomplete-here (funcall pcomplete-command-completion-function))
- (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
- pcomplete-default-completion-function)))
+ (throw 'pcomplete-completions (pcomplete-read-host-names)))))
(defvar block-size)
(defvar by-bytes)
@@ -924,7 +904,7 @@ Summarize disk usage of each FILE, recursively for directories.")
;; filesystem support means nothing under Windows
(if (eshell-under-windows-p)
(setq only-one-filesystem nil))
- (let ((size 0.0) ange-cache)
+ (let ((size 0.0))
(while args
(if only-one-filesystem
(setq only-one-filesystem
@@ -1026,18 +1006,17 @@ Show wall-clock time elapsed during execution of COMMAND.")
(throw 'eshell-replace-command
(eshell-parse-command "*diff" orig-args))))
(when (fboundp 'diff-mode)
- (make-local-variable 'compilation-finish-functions)
(add-hook
'compilation-finish-functions
- `(lambda (buff msg)
+ (lambda (buff _msg)
(with-current-buffer buff
(diff-mode)
- (set (make-local-variable 'eshell-diff-window-config)
- ,config)
- (local-set-key [?q] 'eshell-diff-quit)
+ (set (make-local-variable 'eshell-diff-window-config) config)
+ (local-set-key [?q] #'eshell-diff-quit)
(if (fboundp 'turn-on-font-lock-if-enabled)
(turn-on-font-lock-if-enabled))
- (goto-char (point-min))))))
+ (goto-char (point-min))))
+ nil t))
(pop-to-buffer (current-buffer))))))
nil)
diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el
index d55986c49b8..3c038edfd18 100644
--- a/lisp/eshell/em-xtra.el
+++ b/lisp/eshell/em-xtra.el
@@ -94,36 +94,6 @@ naturally accessible within Emacs."
(defalias 'eshell/ff 'find-name-dired)
(defalias 'eshell/gf 'find-grep-dired)
-(defun pcomplete/bcc32 ()
- "Completion function for Borland's C++ compiler."
- (let ((cur (pcomplete-arg 0)))
- (cond
- ((string-match "\\`-w\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
- (pcomplete-here
- '("ali" "amb" "amp" "asc" "asm" "aus" "bbf" "bei" "big" "ccc"
- "cln" "cod" "com" "cpt" "csu" "def" "dig" "dpu" "dsz" "dup"
- "eas" "eff" "ext" "hch" "hid" "ias" "ibc" "ifr" "ill" "nil"
- "lin" "lvc" "mcs" "mes" "mpc" "mpd" "msg" "nak" "ncf" "nci"
- "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf"
- "nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par"
- "pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret"
- "rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai"
- "tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur)))
- ((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs) (match-string 2 cur)))
- ((string-match "\\`-[Ee]\\(.*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs-or-entries "\\.[Ee][Xx][Ee]\\'")
- (match-string 1 cur)))
- ((string-match "\\`-o\\(.*\\)\\'" cur)
- (pcomplete-here (pcomplete-dirs-or-entries "\\.[Oo][Bb][Jj]\\'")
- (match-string 1 cur)))
- (t
- (pcomplete-opt "3456ABCDEHIKLMNOPRSTUVXabcdefgijklnoptuvwxyz"))))
- (while (pcomplete-here
- (pcomplete-dirs-or-entries "\\.[iCc]\\([Pp][Pp]\\)?\\'"))))
-
-(defalias 'pcomplete/bcc 'pcomplete/bcc32)
-
(provide 'em-xtra)
;; Local Variables:
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 86ceb41ffd2..aefda647689 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -85,51 +85,48 @@ If POS is nil, the location of point is checked."
'eshell-parse-special-reference
;; numbers convert to numbers if they stand alone
- (function
- (lambda ()
- (when (and (not eshell-current-argument)
- (not eshell-current-quoted)
- (looking-at eshell-number-regexp)
- (eshell-arg-delimiter (match-end 0)))
- (goto-char (match-end 0))
- (let ((str (match-string 0)))
- (if (> (length str) 0)
- (add-text-properties 0 (length str) '(number t) str))
- str))))
+ (lambda ()
+ (when (and (not eshell-current-argument)
+ (not eshell-current-quoted)
+ (looking-at eshell-number-regexp)
+ (eshell-arg-delimiter (match-end 0)))
+ (goto-char (match-end 0))
+ (let ((str (match-string 0)))
+ (if (> (length str) 0)
+ (add-text-properties 0 (length str) '(number t) str))
+ str)))
;; parse any non-special characters, based on the current context
- (function
- (lambda ()
- (unless eshell-inside-quote-regexp
- (setq eshell-inside-quote-regexp
- (format "[^%s]+"
- (apply 'string eshell-special-chars-inside-quoting))))
- (unless eshell-outside-quote-regexp
- (setq eshell-outside-quote-regexp
- (format "[^%s]+"
- (apply 'string eshell-special-chars-outside-quoting))))
- (when (looking-at (if eshell-current-quoted
- eshell-inside-quote-regexp
- eshell-outside-quote-regexp))
- (goto-char (match-end 0))
- (let ((str (match-string 0)))
- (if str
- (set-text-properties 0 (length str) nil str))
- str))))
+ (lambda ()
+ (unless eshell-inside-quote-regexp
+ (setq eshell-inside-quote-regexp
+ (format "[^%s]+"
+ (apply 'string eshell-special-chars-inside-quoting))))
+ (unless eshell-outside-quote-regexp
+ (setq eshell-outside-quote-regexp
+ (format "[^%s]+"
+ (apply 'string eshell-special-chars-outside-quoting))))
+ (when (looking-at (if eshell-current-quoted
+ eshell-inside-quote-regexp
+ eshell-outside-quote-regexp))
+ (goto-char (match-end 0))
+ (let ((str (match-string 0)))
+ (if str
+ (set-text-properties 0 (length str) nil str))
+ str)))
;; whitespace or a comment is an argument delimiter
- (function
- (lambda ()
- (let (comment-p)
- (when (or (looking-at "[ \t]+")
- (and (not eshell-current-argument)
- (looking-at "#\\([^<'].*\\|$\\)")
- (setq comment-p t)))
- (if comment-p
- (add-text-properties (match-beginning 0) (match-end 0)
- '(comment t)))
- (goto-char (match-end 0))
- (eshell-finish-arg)))))
+ (lambda ()
+ (let (comment-p)
+ (when (or (looking-at "[ \t]+")
+ (and (not eshell-current-argument)
+ (looking-at "#\\([^<'].*\\|$\\)")
+ (setq comment-p t)))
+ (if comment-p
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(comment t)))
+ (goto-char (match-end 0))
+ (eshell-finish-arg))))
;; parse backslash and the character after
'eshell-parse-backslash
@@ -155,14 +152,22 @@ treated as a literal character."
:type 'hook
:group 'eshell-arg)
+(defvar eshell-arg-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c M-b") #'eshell-insert-buffer-name)
+ map))
+
;;; Functions:
+(define-minor-mode eshell-arg-mode
+ "Minor mode for the arg eshell module.
+
+\\{eshell-arg-mode-map}"
+ :keymap eshell-arg-mode-map)
+
(defun eshell-arg-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the argument parsing code."
- ;; This is supposedly run after enabling esh-mode, when eshell-mode-map
- ;; already exists.
- (defvar eshell-command-map)
- (define-key eshell-command-map [(meta ?b)] 'eshell-insert-buffer-name)
+ (eshell-arg-mode)
(set (make-local-variable 'eshell-inside-quote-regexp) nil)
(set (make-local-variable 'eshell-outside-quote-regexp) nil))
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index e0348ba5013..f1cf9336899 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -304,10 +304,9 @@ otherwise t.")
;; situation can occur, for example, if a Lisp function results in
;; `debug' being called, and the user then types \\[top-level]
(add-hook 'eshell-post-command-hook
- (function
- (lambda ()
- (setq eshell-current-command nil
- eshell-last-async-proc nil)))
+ (lambda ()
+ (setq eshell-current-command nil
+ eshell-last-async-proc nil))
nil t)
(add-hook 'eshell-parse-argument-hook
@@ -355,18 +354,17 @@ hooks should be run before and after the command."
args))
(commands
(mapcar
- (function
- (lambda (cmd)
- (setq cmd
- (if (or (not (car eshell--sep-terms))
- (string= (car eshell--sep-terms) ";"))
- (eshell-parse-pipeline cmd)
- `(eshell-do-subjob
- (list ,(eshell-parse-pipeline cmd)))))
- (setq eshell--sep-terms (cdr eshell--sep-terms))
- (if eshell-in-pipeline-p
- cmd
- `(eshell-trap-errors ,cmd))))
+ (lambda (cmd)
+ (setq cmd
+ (if (or (not (car eshell--sep-terms))
+ (string= (car eshell--sep-terms) ";"))
+ (eshell-parse-pipeline cmd)
+ `(eshell-do-subjob
+ (list ,(eshell-parse-pipeline cmd)))))
+ (setq eshell--sep-terms (cdr eshell--sep-terms))
+ (if eshell-in-pipeline-p
+ cmd
+ `(eshell-trap-errors ,cmd)))
(eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms))))
(let ((cmd commands))
(while cmd
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index 0aa4ec4d16c..b4154861908 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -382,12 +382,7 @@ it defaults to `insert'."
"Set handle INDEX, using MODE, to point to TARGET."
(when target
(if (and (stringp target)
- (or (cond
- ((boundp 'null-device)
- (string= target null-device))
- ((boundp 'grep-null-device)
- (string= target grep-null-device))
- (t nil))
+ (or (string= target null-device)
(string= target "/dev/null")))
(aset eshell-current-handles index nil)
(let ((where (eshell-get-target target mode))
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index db5fddb2aaf..a80c2fc60d9 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -72,51 +72,43 @@
(defcustom eshell-mode-unload-hook nil
"A hook that gets run when `eshell-mode' is unloaded."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-mode-hook nil
"A hook that gets run when `eshell-mode' is entered."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-first-time-mode-hook nil
"A hook that gets run the first time `eshell-mode' is entered.
That is to say, the first time during an Emacs session."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-exit-hook nil
"A hook that is run whenever `eshell' is exited.
This hook is only run if exiting actually kills the buffer."
:version "24.1" ; removed eshell-query-kill-processes
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-kill-on-exit t
"If non-nil, kill the Eshell buffer on the `exit' command.
Otherwise, the buffer will simply be buried."
- :type 'boolean
- :group 'eshell-mode)
+ :type 'boolean)
(defcustom eshell-input-filter-functions nil
"Functions to call before input is processed.
The input is contained in the region from `eshell-last-input-start' to
`eshell-last-input-end'."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-send-direct-to-subprocesses nil
"If t, send any input immediately to a subprocess."
- :type 'boolean
- :group 'eshell-mode)
+ :type 'boolean)
(defcustom eshell-expand-input-functions nil
"Functions to call before input is parsed.
Each function is passed two arguments, which bounds the region of the
current input text."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-scroll-to-bottom-on-input nil
"Controls whether input to interpreter causes window to scroll.
@@ -126,8 +118,7 @@ buffer. If `this', scroll only the selected window.
See `eshell-preinput-scroll-to-bottom'."
:type '(radio (const :tag "Do not scroll Eshell windows" nil)
(const :tag "Scroll all windows showing the buffer" all)
- (const :tag "Scroll only the selected window" this))
- :group 'eshell-mode)
+ (const :tag "Scroll only the selected window" this)))
(defcustom eshell-scroll-to-bottom-on-output nil
"Controls whether interpreter output causes window to scroll.
@@ -140,8 +131,7 @@ See variable `eshell-scroll-show-maximum-output' and function
:type '(radio (const :tag "Do not scroll Eshell windows" nil)
(const :tag "Scroll all windows showing the buffer" all)
(const :tag "Scroll only the selected window" this)
- (const :tag "Scroll all windows other than selected" others))
- :group 'eshell-mode)
+ (const :tag "Scroll all windows other than selected" others)))
(defcustom eshell-scroll-show-maximum-output t
"Controls how interpreter output causes window to scroll.
@@ -149,16 +139,14 @@ If non-nil, then show the maximum output when the window is scrolled.
See variable `eshell-scroll-to-bottom-on-output' and function
`eshell-postoutput-scroll-to-bottom'."
- :type 'boolean
- :group 'eshell-mode)
+ :type 'boolean)
(defcustom eshell-buffer-maximum-lines 1024
"The maximum size in lines for eshell buffers.
Eshell buffers are truncated from the top to be no greater than this
number, if the function `eshell-truncate-buffer' is on
`eshell-output-filter-functions'."
- :type 'integer
- :group 'eshell-mode)
+ :type 'integer)
(defcustom eshell-output-filter-functions
'(eshell-postoutput-scroll-to-bottom
@@ -168,36 +156,31 @@ number, if the function `eshell-truncate-buffer' is on
"Functions to call before output is displayed.
These functions are only called for output that is displayed
interactively, and not for output which is redirected."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-preoutput-filter-functions nil
"Functions to call before output is inserted into the buffer.
These functions get one argument, a string containing the text to be
inserted. They return the string as it should be inserted."
- :type 'hook
- :group 'eshell-mode)
+ :type 'hook)
(defcustom eshell-password-prompt-regexp
(format "\\(%s\\)[^::៖]*[::៖]\\s *\\'" (regexp-opt password-word-equivalents))
"Regexp matching prompts for passwords in the inferior process.
This is used by `eshell-watch-for-password-prompt'."
:type 'regexp
- :version "27.1"
- :group 'eshell-mode)
+ :version "27.1")
(defcustom eshell-skip-prompt-function nil
"A function called from beginning of line to skip the prompt."
- :type '(choice (const nil) function)
- :group 'eshell-mode)
+ :type '(choice (const nil) function))
(define-obsolete-variable-alias 'eshell-status-in-modeline
'eshell-status-in-mode-line "24.3")
(defcustom eshell-status-in-mode-line t
"If non-nil, let the user know a command is running in the mode line."
- :type 'boolean
- :group 'eshell-mode)
+ :type 'boolean)
(defcustom eshell-directory-name
(locate-user-emacs-file "eshell/" ".eshell/")
@@ -213,10 +196,7 @@ This is used by `eshell-watch-for-password-prompt'."
;; these are only set to nil initially for the sake of the
;; byte-compiler, when compiling other files which `require' this one
(defvar eshell-mode nil)
-(defvar eshell-mode-map nil)
(defvar eshell-command-running-string "--")
-(defvar eshell-command-map nil)
-(defvar eshell-command-prefix nil)
(defvar eshell-last-input-start nil)
(defvar eshell-last-input-end nil)
(defvar eshell-last-output-start nil)
@@ -280,6 +260,32 @@ This is used by `eshell-watch-for-password-prompt'."
(standard-syntax-table))
st))
+(defvar eshell-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?c)] 'eshell-command-map)
+ (define-key map "\r" #'eshell-send-input)
+ (define-key map "\M-\r" #'eshell-queue-input)
+ (define-key map [(meta control ?l)] #'eshell-show-output)
+ (define-key map [(control ?a)] #'eshell-bol)
+ map))
+
+(defvar eshell-command-map
+ (let ((map (define-prefix-command 'eshell-command-map)))
+ (define-key map [(meta ?o)] #'eshell-mark-output)
+ (define-key map [(meta ?d)] #'eshell-toggle-direct-send)
+ (define-key map [(control ?a)] #'eshell-bol)
+ (define-key map [(control ?b)] #'eshell-backward-argument)
+ (define-key map [(control ?e)] #'eshell-show-maximum-output)
+ (define-key map [(control ?f)] #'eshell-forward-argument)
+ (define-key map [(control ?m)] #'eshell-copy-old-input)
+ (define-key map [(control ?o)] #'eshell-kill-output)
+ (define-key map [(control ?r)] #'eshell-show-output)
+ (define-key map [(control ?t)] #'eshell-truncate-buffer)
+ (define-key map [(control ?u)] #'eshell-kill-input)
+ (define-key map [(control ?w)] #'backward-kill-word)
+ (define-key map [(control ?y)] #'eshell-repeat-argument)
+ map))
+
;;; User Functions:
(defun eshell-kill-buffer-function ()
@@ -298,10 +304,6 @@ and the hook `eshell-exit-hook'."
"Emacs shell interactive mode."
(setq-local eshell-mode t)
- ;; FIXME: What the hell!?
- (setq-local eshell-mode-map (make-sparse-keymap))
- (use-local-map eshell-mode-map)
-
(when eshell-status-in-mode-line
(make-local-variable 'eshell-command-running-string)
(let ((fmt (copy-sequence mode-line-format)))
@@ -310,31 +312,8 @@ and the hook `eshell-exit-hook'."
(if mode-line-elt
(setcar mode-line-elt 'eshell-command-running-string))))
- (define-key eshell-mode-map "\r" 'eshell-send-input)
- (define-key eshell-mode-map "\M-\r" 'eshell-queue-input)
- (define-key eshell-mode-map [(meta control ?l)] 'eshell-show-output)
- (define-key eshell-mode-map [(control ?a)] 'eshell-bol)
-
- (setq-local eshell-command-prefix (make-symbol "eshell-command-prefix"))
- (fset eshell-command-prefix (make-sparse-keymap))
- (setq-local eshell-command-map (symbol-function eshell-command-prefix))
- (define-key eshell-mode-map [(control ?c)] eshell-command-prefix)
-
- (define-key eshell-command-map [(meta ?o)] 'eshell-mark-output)
- (define-key eshell-command-map [(meta ?d)] 'eshell-toggle-direct-send)
-
- (define-key eshell-command-map [(control ?a)] 'eshell-bol)
- (define-key eshell-command-map [(control ?b)] 'eshell-backward-argument)
- (define-key eshell-command-map [(control ?e)] 'eshell-show-maximum-output)
- (define-key eshell-command-map [(control ?f)] 'eshell-forward-argument)
- (define-key eshell-command-map [(control ?m)] 'eshell-copy-old-input)
- (define-key eshell-command-map [(control ?o)] 'eshell-kill-output)
- (define-key eshell-command-map [(control ?r)] 'eshell-show-output)
- (define-key eshell-command-map [(control ?t)] 'eshell-truncate-buffer)
- (define-key eshell-command-map [(control ?u)] 'eshell-kill-input)
- (define-key eshell-command-map [(control ?w)] 'backward-kill-word)
- (define-key eshell-command-map [(control ?y)] 'eshell-repeat-argument)
-
+ (set (make-local-variable 'bookmark-make-record-function)
+ 'eshell-bookmark-make-record)
(setq local-abbrev-table eshell-mode-abbrev-table)
(set (make-local-variable 'list-buffers-directory)
@@ -696,46 +675,47 @@ newline."
"Send the output from PROCESS (STRING) to the interactive display.
This is done after all necessary filtering has been done."
(let ((oprocbuf (if process (process-buffer process)
- (current-buffer)))
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t))
- (let ((functions eshell-preoutput-filter-functions))
- (while (and functions string)
- (setq string (funcall (car functions) string))
- (setq functions (cdr functions))))
- (if (and string oprocbuf (buffer-name oprocbuf))
- (let (opoint obeg oend)
- (with-current-buffer oprocbuf
- (setq opoint (point))
- (setq obeg (point-min))
- (setq oend (point-max))
- (let ((buffer-read-only nil)
- (nchars (length string))
- (ostart nil))
- (widen)
- (goto-char eshell-last-output-end)
- (setq ostart (point))
- (if (<= (point) opoint)
- (setq opoint (+ opoint nchars)))
- (if (< (point) obeg)
- (setq obeg (+ obeg nchars)))
- (if (<= (point) oend)
- (setq oend (+ oend nchars)))
+ (current-buffer)))
+ (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t))
+ (when (and string oprocbuf (buffer-name oprocbuf))
+ (with-current-buffer oprocbuf
+ (let ((functions eshell-preoutput-filter-functions))
+ (while (and functions string)
+ (setq string (funcall (car functions) string))
+ (setq functions (cdr functions))))
+ (when string
+ (let (opoint obeg oend)
+ (setq opoint (point))
+ (setq obeg (point-min))
+ (setq oend (point-max))
+ (let ((buffer-read-only nil)
+ (nchars (length string))
+ (ostart nil))
+ (widen)
+ (goto-char eshell-last-output-end)
+ (setq ostart (point))
+ (if (<= (point) opoint)
+ (setq opoint (+ opoint nchars)))
+ (if (< (point) obeg)
+ (setq obeg (+ obeg nchars)))
+ (if (<= (point) oend)
+ (setq oend (+ oend nchars)))
;; Let the ansi-color overlay hooks run.
(let ((inhibit-modification-hooks nil))
(insert-before-markers string))
- (if (= (window-start) (point))
- (set-window-start (selected-window)
- (- (point) nchars)))
- (if (= (point) eshell-last-input-end)
- (set-marker eshell-last-input-end
- (- eshell-last-input-end nchars)))
- (set-marker eshell-last-output-start ostart)
- (set-marker eshell-last-output-end (point))
- (force-mode-line-update))
- (narrow-to-region obeg oend)
- (goto-char opoint)
- (eshell-run-output-filters))))))
+ (if (= (window-start) (point))
+ (set-window-start (selected-window)
+ (- (point) nchars)))
+ (if (= (point) eshell-last-input-end)
+ (set-marker eshell-last-input-end
+ (- eshell-last-input-end nchars)))
+ (set-marker eshell-last-output-start ostart)
+ (set-marker eshell-last-output-end (point))
+ (force-mode-line-update))
+ (narrow-to-region obeg oend)
+ (goto-char opoint)
+ (eshell-run-output-filters)))))))
(defun eshell-run-output-filters ()
"Run the `eshell-output-filter-functions' on the current output."
@@ -762,13 +742,12 @@ This function should be a pre-command hook."
(if (eq scroll 'this)
(goto-char (point-max))
(walk-windows
- (function
- (lambda (window)
- (when (and (eq (window-buffer window) current)
- (or (eq scroll t) (eq scroll 'all)))
- (select-window window)
- (goto-char (point-max))
- (select-window selected))))
+ (lambda (window)
+ (when (and (eq (window-buffer window) current)
+ (or (eq scroll t) (eq scroll 'all)))
+ (select-window window)
+ (goto-char (point-max))
+ (select-window selected)))
nil t))))))
;;; jww (1999-10-23): this needs testing
@@ -784,29 +763,28 @@ This function should be in the list `eshell-output-filter-functions'."
(scroll eshell-scroll-to-bottom-on-output))
(unwind-protect
(walk-windows
- (function
- (lambda (window)
- (if (eq (window-buffer window) current)
- (progn
- (select-window window)
- (if (and (< (point) eshell-last-output-end)
- (or (eq scroll t) (eq scroll 'all)
- ;; Maybe user wants point to jump to end.
- (and (eq scroll 'this)
- (eq selected window))
- (and (eq scroll 'others)
- (not (eq selected window)))
- ;; If point was at the end, keep it at end.
- (>= (point) eshell-last-output-start)))
- (goto-char eshell-last-output-end))
- ;; Optionally scroll so that the text
- ;; ends at the bottom of the window.
- (if (and eshell-scroll-show-maximum-output
- (>= (point) eshell-last-output-end))
- (save-excursion
- (goto-char (point-max))
- (recenter -1)))
- (select-window selected)))))
+ (lambda (window)
+ (if (eq (window-buffer window) current)
+ (progn
+ (select-window window)
+ (if (and (< (point) eshell-last-output-end)
+ (or (eq scroll t) (eq scroll 'all)
+ ;; Maybe user wants point to jump to end.
+ (and (eq scroll 'this)
+ (eq selected window))
+ (and (eq scroll 'others)
+ (not (eq selected window)))
+ ;; If point was at the end, keep it at end.
+ (>= (point) eshell-last-output-start)))
+ (goto-char eshell-last-output-end))
+ ;; Optionally scroll so that the text
+ ;; ends at the bottom of the window.
+ (if (and eshell-scroll-show-maximum-output
+ (>= (point) eshell-last-output-end))
+ (save-excursion
+ (goto-char (point-max))
+ (recenter -1)))
+ (select-window selected))))
nil t)
(set-buffer current))))
@@ -1020,5 +998,29 @@ This function could be in the list `eshell-output-filter-functions'."
(custom-add-option 'eshell-output-filter-functions
'eshell-handle-ansi-color)
+;;; Bookmark support:
+
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+
+(defun eshell-bookmark-name ()
+ (format "eshell-%s"
+ (file-name-nondirectory
+ (directory-file-name
+ (file-name-directory default-directory)))))
+
+(defun eshell-bookmark-make-record ()
+ "Create a bookmark for the current Eshell buffer."
+ `(,(eshell-bookmark-name)
+ (location . ,default-directory)
+ (handler . eshell-bookmark-jump)))
+
+;;;###autoload
+(defun eshell-bookmark-jump (bookmark)
+ "Default bookmark handler for Eshell buffers."
+ (let ((default-directory (bookmark-prop-get bookmark 'location)))
+ (eshell)))
+
(provide 'esh-mode)
;;; esh-mode.el ends here
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el
index 45c4c9e13c0..10994ba3010 100644
--- a/lisp/eshell/esh-module.el
+++ b/lisp/eshell/esh-module.el
@@ -65,16 +65,15 @@ Changes will only take effect in future Eshell buffers."
:type (append
(list 'set ':tag "Supported modules")
(mapcar
- (function
- (lambda (modname)
- (let ((modsym (intern modname)))
- (list 'const
- ':tag (format "%s -- %s" modname
- (get modsym 'custom-tag))
- ':link (caar (get modsym 'custom-links))
- ':doc (concat "\n" (get modsym 'group-documentation)
- "\n ")
- modsym))))
+ (lambda (modname)
+ (let ((modsym (intern modname)))
+ (list 'const
+ ':tag (format "%s -- %s" modname
+ (get modsym 'custom-tag))
+ ':link (caar (get modsym 'custom-links))
+ ':doc (concat "\n" (get modsym 'group-documentation)
+ "\n ")
+ modsym)))
(sort (mapcar 'symbol-name
(eshell-subgroups 'eshell-module))
'string-lessp))
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index c3ac3a5b71b..4a1001bf058 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -109,6 +109,16 @@ information, for example."
(defvar eshell-process-list nil
"A list of the current status of subprocesses.")
+(defvar eshell-proc-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c M-i") #'eshell-insert-process)
+ (define-key map (kbd "C-c C-c") #'eshell-interrupt-process)
+ (define-key map (kbd "C-c C-k") #'eshell-kill-process)
+ (define-key map (kbd "C-c C-d") #'eshell-send-eof-to-process)
+ (define-key map (kbd "C-c C-s") #'list-processes)
+ (define-key map (kbd "C-c C-\\") #'eshell-quit-process)
+ map))
+
;;; Functions:
(defun eshell-kill-process-function (proc status)
@@ -121,20 +131,16 @@ PROC and STATUS to functions on the latter."
(eshell-reset-after-proc status)
(run-hook-with-args 'eshell-kill-hook proc status))
+(define-minor-mode eshell-proc-mode
+ "Minor mode for the proc eshell module.
+
+\\{eshell-proc-mode-map}"
+ :keymap eshell-proc-mode-map)
+
(defun eshell-proc-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the process handling code."
(make-local-variable 'eshell-process-list)
- ;; This is supposedly run after enabling esh-mode, when eshell-command-map
- ;; already exists.
- (defvar eshell-command-map)
- (define-key eshell-command-map [(meta ?i)] 'eshell-insert-process)
- (define-key eshell-command-map [(control ?c)] 'eshell-interrupt-process)
- (define-key eshell-command-map [(control ?k)] 'eshell-kill-process)
- (define-key eshell-command-map [(control ?d)] 'eshell-send-eof-to-process)
-; (define-key eshell-command-map [(control ?q)] 'eshell-continue-process)
- (define-key eshell-command-map [(control ?s)] 'list-processes)
-; (define-key eshell-command-map [(control ?z)] 'eshell-stop-process)
- (define-key eshell-command-map [(control ?\\)] 'eshell-quit-process))
+ (eshell-proc-mode))
(defun eshell-reset-after-proc (status)
"Reset the command input location after a process terminates.
@@ -209,9 +215,8 @@ and signal names."
The prompt will be set to PROMPT."
(completing-read prompt
(mapcar
- (function
- (lambda (proc)
- (cons (process-name proc) t)))
+ (lambda (proc)
+ (cons (process-name proc) t))
(process-list))
nil t))
@@ -289,7 +294,7 @@ See `eshell-needs-pipe'."
(process-environment (eshell-environment-variables))
proc decoding encoding changed)
(cond
- ((fboundp 'start-file-process)
+ ((fboundp 'make-process)
(setq proc
(let ((process-connection-type
(unless (eshell-needs-pipe-p command)
@@ -493,9 +498,8 @@ See the variable `eshell-kill-processes-on-exit'."
(let ((sigs eshell-kill-process-signals))
(while sigs
(eshell-process-interact
- (function
- (lambda (proc)
- (signal-process (process-id proc) (car sigs)))) t query)
+ (lambda (proc)
+ (signal-process (process-id proc) (car sigs))) t query)
(setq query nil)
(if (not eshell-process-list)
(setq sigs nil)
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index adf39061468..9268921fadc 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -51,9 +51,15 @@ similarly to external commands, as far as successful result output."
:group 'eshell-util)
(defcustom eshell-hosts-file "/etc/hosts"
- "The name of the /etc/hosts file."
+ "The name of the /etc/hosts file.
+Use `pcomplete-hosts-file' instead; this variable is obsolete and
+has no effect."
:type '(choice (const :tag "No hosts file" nil) file)
:group 'eshell-util)
+;; Don't make it into an alias, because it doesn't really work with
+;; custom and risks creating duplicate entries. Just point users to
+;; the other variable, which is less frustrating.
+(make-obsolete-variable 'eshell-hosts-file nil "28.1")
(defcustom eshell-handle-errors t
"If non-nil, Eshell will handle errors itself.
@@ -127,11 +133,14 @@ function `string-to-number'."
(defvar eshell-user-timestamp nil
"A timestamp of when the user file was read.")
-(defvar eshell-host-names nil
- "A cache the names of frequently accessed hosts.")
+;;; Obsolete variables:
-(defvar eshell-host-timestamp nil
- "A timestamp of when the hosts file was read.")
+(define-obsolete-variable-alias 'eshell-host-names
+ 'pcomplete--host-name-cache "28.1")
+(define-obsolete-variable-alias 'eshell-host-timestamp
+ 'pcomplete--host-name-cache-timestamp "28.1")
+(defvar pcomplete--host-name-cache)
+(defvar pcomplete--host-name-cache-timestamp)
;;; Functions:
@@ -479,37 +488,15 @@ list."
(defalias 'eshell-user-name 'user-login-name)
-(defun eshell-read-hosts-file (filename)
- "Read in the hosts from FILENAME, default `eshell-hosts-file'."
- (let (hosts)
- (with-temp-buffer
- (insert-file-contents (or filename eshell-hosts-file))
- (goto-char (point-min))
- (while (re-search-forward
- ;; "^ \t\\([^# \t\n]+\\)[ \t]+\\([^ \t\n]+\\)\\([ \t]*\\([^ \t\n]+\\)\\)?"
- "^[ \t]*\\([^# \t\n]+\\)[ \t]+\\([^ \t\n].+\\)" nil t)
- (push (cons (match-string 1)
- (split-string (match-string 2)))
- hosts)))
- (nreverse hosts)))
-
-(defun eshell-read-hosts (file result-var timestamp-var)
- "Read the contents of /etc/hosts for host names."
- (if (or (not (symbol-value result-var))
- (not (symbol-value timestamp-var))
- (time-less-p
- (symbol-value timestamp-var)
- (file-attribute-modification-time (file-attributes file))))
- (progn
- (set result-var (apply #'nconc (eshell-read-hosts-file file)))
- (set timestamp-var (current-time))))
- (symbol-value result-var))
-
-(defun eshell-read-host-names ()
- "Read the contents of /etc/hosts for host names."
- (if eshell-hosts-file
- (eshell-read-hosts eshell-hosts-file 'eshell-host-names
- 'eshell-host-timestamp)))
+(autoload 'pcomplete-read-hosts-file "pcomplete")
+(autoload 'pcomplete-read-hosts "pcomplete")
+(autoload 'pcomplete-read-host-names "pcomplete")
+(define-obsolete-function-alias 'eshell-read-hosts-file
+ #'pcomplete-read-hosts-file "28.1")
+(define-obsolete-function-alias 'eshell-read-hosts
+ #'pcomplete-read-hosts "28.1")
+(define-obsolete-function-alias 'eshell-read-host-names
+ #'pcomplete-read-host-names "28.1")
(defsubst eshell-copy-environment ()
"Return an unrelated copy of `process-environment'."
@@ -647,14 +634,8 @@ gid format. Valid values are `string' and `integer', defaulting to
(let ((base (file-name-nondirectory file))
(dir (file-name-directory file)))
(if (string-equal "" base) (setq base "."))
- (if (boundp 'ange-cache)
- (setq entry (cdr (assoc base (cdr (assoc dir ange-cache))))))
(unless entry
(setq entry (eshell-parse-ange-ls dir))
- (if (boundp 'ange-cache)
- (setq ange-cache
- (cons (cons dir entry)
- ange-cache)))
(if entry
(let ((fentry (assoc base (cdr entry))))
(if fentry
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 75ccf5b8353..f91fb89412e 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -179,26 +179,50 @@ if they are quoted with a backslash."
(eshell-apply-indices eshell-command-arguments
indices)))))
"This list provides aliasing for variable references.
-It is very similar in concept to what `eshell-user-aliases-list' does
-for commands. Each member of this defines the name of a command,
-and the Lisp value to return for that variable if it is accessed
-via the syntax `$NAME'.
-
-If the value is a function, that function will be called with two
-arguments: the list of the indices that was used in the reference, and
-whether the user is requesting the length of the ultimate element.
-For example, a reference of `$NAME[10][20]' would result in the
-function for alias `NAME' being called (assuming it were aliased to a
-function), and the arguments passed to this function would be the list
-'(10 20)', and nil."
+Each member defines the name of a variable, and a Lisp value used to
+compute the string value that will be returned when the variable is
+accessed via the syntax `$NAME'.
+
+If the value is a function, call that function with two arguments: the
+list of the indices that was used in the reference, and whether the
+user is requesting the length of the ultimate element. For example, a
+reference of `$NAME[10][20]' would result in the function for alias
+`NAME' being called (assuming it were aliased to a function), and the
+arguments passed to this function would be the list '(10 20)', and
+nil.
+
+If the value is a string, return the value for the variable with that
+name in the current environment. If no variable with that name exists
+in the environment, but if a symbol with that same name exists and has
+a value bound to it, return its value instead. You can prioritize
+symbol values over environment values by setting
+`eshell-prefer-lisp-variables' to t.
+
+If the value is a symbol, return the value bound to it.
+
+If the value has any other type, signal an error.
+
+Additionally, each member may specify if it should be copied to the
+environment of created subprocesses."
:type '(repeat (list string sexp
(choice (const :tag "Copy to environment" t)
(const :tag "Use only in Eshell" nil)))))
(put 'eshell-variable-aliases-list 'risky-local-variable t)
+(defvar eshell-var-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c M-v") #'eshell-insert-envvar)
+ map))
+
;;; Functions:
+(define-minor-mode eshell-var-mode
+ "Minor mode for the esh-var module.
+
+\\{eshell-var-mode-map}"
+ :keymap eshell-var-mode-map)
+
(defun eshell-var-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the variable handle code."
;; Break the association with our parent's environment. Otherwise,
@@ -207,11 +231,6 @@ function), and the arguments passed to this function would be the list
(set (make-local-variable 'process-environment)
(eshell-copy-environment)))
- ;; This is supposedly run after enabling esh-mode, when eshell-command-map
- ;; already exists.
- (defvar eshell-command-map)
- (define-key eshell-command-map [(meta ?v)] 'eshell-insert-envvar)
-
(set (make-local-variable 'eshell-special-chars-inside-quoting)
(append eshell-special-chars-inside-quoting '(?$)))
(set (make-local-variable 'eshell-special-chars-outside-quoting)
@@ -363,9 +382,8 @@ This function is explicit for adding to `eshell-parse-argument-hook'."
(defun eshell-envvar-names (&optional environment)
"Return a list of currently visible environment variable names."
- (mapcar (function
- (lambda (x)
- (substring x 0 (string-match "=" x))))
+ (mapcar (lambda (x)
+ (substring x 0 (string-match "=" x)))
(or environment process-environment)))
(defun eshell-environment-variables ()
@@ -444,8 +462,8 @@ Possible options are:
(eshell-as-subcommand ,(eshell-parse-command cmd))
(ignore
(nconc eshell-this-command-hook
- (list (function (lambda ()
- (delete-file ,temp))))))
+ (list (lambda ()
+ (delete-file ,temp)))))
(quote ,temp)))
(goto-char (1+ end)))))))
((eq (char-after) ?\()
@@ -599,14 +617,13 @@ For example, to retrieve the second element of a user's record in
(sort
(append
(mapcar
- (function
- (lambda (varname)
- (let ((value (eshell-get-variable varname)))
- (if (and value
- (stringp value)
- (file-directory-p value))
- (concat varname "/")
- varname))))
+ (lambda (varname)
+ (let ((value (eshell-get-variable varname)))
+ (if (and value
+ (stringp value)
+ (file-directory-p value))
+ (concat varname "/")
+ varname)))
(eshell-envvar-names (eshell-environment-variables)))
(all-completions argname obarray 'boundp)
completions)
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index 2a63882ff09..6698ca45de4 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -265,14 +265,18 @@ information on Eshell, see Info node `(eshell)Top'."
(eshell-mode))
buf))
-(defun eshell-return-exits-minibuffer ()
- ;; This is supposedly run after enabling esh-mode, when eshell-mode-map
- ;; already exists.
- (defvar eshell-mode-map)
- (define-key eshell-mode-map [(control ?g)] 'abort-recursive-edit)
- (define-key eshell-mode-map [(control ?m)] 'exit-minibuffer)
- (define-key eshell-mode-map [(control ?j)] 'exit-minibuffer)
- (define-key eshell-mode-map [(meta control ?m)] 'exit-minibuffer))
+(define-minor-mode eshell-command-mode
+ "Minor mode for `eshell-command' input.
+\\{eshell-command-mode-map}"
+ :keymap (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?g)] 'abort-recursive-edit)
+ (define-key map [(control ?m)] 'exit-minibuffer)
+ (define-key map [(control ?j)] 'exit-minibuffer)
+ (define-key map [(meta control ?m)] 'exit-minibuffer)
+ map))
+
+(define-obsolete-function-alias 'eshell-return-exits-minibuffer
+ #'eshell-command-mode "28.1")
(defvar eshell-non-interactive-p nil
"A variable which is non-nil when Eshell is not running interactively.
@@ -292,7 +296,7 @@ With prefix ARG, insert output into the current buffer at point."
;; Enable `eshell-mode' only in this minibuffer.
(minibuffer-with-setup-hook #'(lambda ()
(eshell-mode)
- (eshell-return-exits-minibuffer))
+ (eshell-command-mode +1))
(unless command
(setq command (read-from-minibuffer "Emacs shell command: "))
(if (eshell-using-module 'eshell-hist)
@@ -380,15 +384,6 @@ corresponding to a successful execution."
(set status-var eshell-last-command-status))
(cadr result))))))
-;;;_* Reporting bugs
-;;
-;; If you do encounter a bug, on any system, please report
-;; it -- in addition to any particular oddities in your configuration
-;; -- so that the problem may be corrected for the benefit of others.
-
-;;;###autoload
-(define-obsolete-function-alias 'eshell-report-bug 'report-emacs-bug "23.1")
-
;;; Code:
(defun eshell-unload-all-modules ()
diff --git a/lisp/expand.el b/lisp/expand.el
index 1417c90fdb4..77e4fc2657c 100644
--- a/lisp/expand.el
+++ b/lisp/expand.el
@@ -55,10 +55,8 @@
;;
;; you can also init some post-process hooks :
;;
-;; (add-hook 'expand-load-hook
-;; (lambda ()
-;; (add-hook 'expand-expand-hook 'indent-according-to-mode)
-;; (add-hook 'expand-jump-hook 'indent-according-to-mode)))
+;; (add-hook 'expand-expand-hook 'indent-according-to-mode)
+;; (add-hook 'expand-jump-hook 'indent-according-to-mode)
;;
;; Remarks:
;;
@@ -78,6 +76,8 @@
"Hooks run when `expand.el' is loaded."
:type 'hook
:group 'expand)
+(make-obsolete-variable 'expand-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom expand-expand-hook nil
"Hooks run when an abbrev made by `expand-add-abbrevs' is expanded."
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index b10d874b21b..3ed4b54d223 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -445,7 +445,7 @@ sets the CHARSET property of the character at point."
(interactive (list (progn
(barf-if-buffer-read-only)
(read-charset
- (format "Use charset (default %s): " (charset-after))
+ (format-prompt "Use charset" (charset-after))
(charset-after)))
(if (and mark-active (not current-prefix-arg))
(region-beginning))
@@ -621,12 +621,11 @@ color. The function should accept a single argument, the color name."
(downcase b))))))
(setq color (list color)))
(let* ((opoint (point))
- (color-values (color-values (car color)))
- (light-p (>= (apply 'max color-values)
- (* (car (color-values "white")) .5))))
+ (fg (readable-foreground-color (car color))))
(insert (car color))
(indent-to 22)
- (put-text-property opoint (point) 'face `(:background ,(car color)))
+ (put-text-property opoint (point) 'face `(:background ,(car color)
+ :foreground ,fg))
(put-text-property
(prog1 (point)
(insert " ")
@@ -639,7 +638,7 @@ color. The function should accept a single argument, the color name."
(insert (propertize
(apply 'format "#%02x%02x%02x"
(mapcar (lambda (c) (ash c -8))
- color-values))
+ (color-values (car color))))
'mouse-face 'highlight
'help-echo
(let ((hsv (apply 'color-rgb-to-hsv
@@ -651,7 +650,7 @@ color. The function should accept a single argument, the color name."
opoint (point)
'follow-link t
'mouse-face (list :background (car color)
- :foreground (if light-p "black" "white"))
+ :foreground fg)
'color-name (car color)
'action callback-fn)))
(insert "\n"))
diff --git a/lisp/faces.el b/lisp/faces.el
index 48c1776648f..7355e1dd0a5 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1212,10 +1212,7 @@ Value is the new attribute value."
(setq name (concat (upcase (substring name 0 1)) (substring name 1)))
(let* ((completion-ignore-case t)
(value (completing-read
- (format-message (if default
- "%s for face `%s' (default %s): "
- "%s for face `%s': ")
- name face default)
+ (format-prompt "%s for face `%s'" default name face)
completion-alist nil nil nil nil default)))
(if (equal value "") default value)))
@@ -1560,7 +1557,7 @@ is given, in which case return its value instead."
;; return it to the caller. Since there will most definitely be something to
;; return in this case, there's no need to know/check if a match was found.
(if defaults
- (append result defaults)
+ (append defaults result)
(if match-found
result
no-match-retval))))
@@ -1785,16 +1782,42 @@ with the color they represent as background color."
(defined-colors frame)))
(defun readable-foreground-color (color)
- "Return a readable foreground color for background COLOR."
- (let* ((rgb (color-values color))
- (max (apply #'max rgb))
- (black (car (color-values "black")))
- (white (car (color-values "white"))))
- ;; Select black or white depending on which one is less similar to
- ;; the brightest component.
- (if (> (abs (- max black)) (abs (- max white)))
- "black"
- "white")))
+ "Return a readable foreground color for background COLOR.
+The returned value is a string representing black or white, depending
+on which one provides better contrast with COLOR."
+ ;; We use #ffffff instead of "white", because the latter is sometimes
+ ;; less than white. That way, we get the best contrast possible.
+ (if (color-dark-p (mapcar (lambda (c) (/ c 65535.0))
+ (color-values color)))
+ "#ffffff" "black"))
+
+(defconst color-luminance-dark-limit 0.325
+ "The relative luminance below which a color is considered 'dark'.
+A 'dark' color in this sense provides better contrast with white
+than with black; see `color-dark-p'.
+This value was determined experimentally.")
+
+(defun color-dark-p (rgb)
+ "Whether RGB is more readable against white than black.
+RGB is a 3-element list (R G B), each component in the range [0,1].
+This predicate can be used both for determining a suitable (black or white)
+contrast colour with RGB as background and as foreground."
+ (unless (<= 0 (apply #'min rgb) (apply #'max rgb) 1)
+ (error "RGB components %S not in [0,1]" rgb))
+ ;; Compute the relative luminance after gamma-correcting (assuming sRGB),
+ ;; and compare to a cut-off value determined experimentally.
+ ;; See https://en.wikipedia.org/wiki/Relative_luminance for details.
+ (let* ((sr (nth 0 rgb))
+ (sg (nth 1 rgb))
+ (sb (nth 2 rgb))
+ ;; Gamma-correct the RGB components to linear values.
+ ;; Use the power 2.2 as an approximation to sRGB gamma;
+ ;; it should be good enough for the purpose of this function.
+ (r (expt sr 2.2))
+ (g (expt sg 2.2))
+ (b (expt sb 2.2))
+ (y (+ (* r 0.2126) (* g 0.7152) (* b 0.0722))))
+ (< y color-luminance-dark-limit)))
(declare-function xw-color-defined-p "xfns.c" (color &optional frame))
@@ -1822,7 +1845,7 @@ COLOR should be a string naming a color (e.g. \"white\"), or a
string specifying a color's RGB components (e.g. \"#ff12ec\").
Return a list of three integers, (RED GREEN BLUE), each between 0
-and either 65280 or 65535 (the maximum depends on the system).
+and 65535 inclusive.
Use `color-name-to-rgb' if you want RGB floating-point values
normalized to 1.0.
@@ -2555,7 +2578,7 @@ non-nil."
:group 'basic-faces)
(defface mode-line-highlight
- '((((class color) (min-colors 88))
+ '((((supports :box t) (class color) (min-colors 88))
:box (:line-width 2 :color "grey40" :style released-button))
(t
:inherit highlight))
@@ -2614,9 +2637,9 @@ Use the face `mode-line-highlight' for features that can be selected."
:version "21.1"
:group 'basic-faces)
-(defface header-line-highlight '((t :inherit highlight))
+(defface header-line-highlight '((t :inherit mode-line-highlight))
"Basic header line face for highlighting."
- :version "26.1"
+ :version "28.1"
:group 'basic-faces)
(defface vertical-border
@@ -2693,9 +2716,11 @@ used to display the prompt text."
:group 'frames
:group 'basic-faces)
-(defface scroll-bar '((t nil))
+(defface scroll-bar
+ '((((background light)) :foreground "black")
+ (((background dark)) :foreground "white"))
"Basic face for the scroll bar colors under X."
- :version "21.1"
+ :version "28.1"
:group 'frames
:group 'basic-faces)
diff --git a/lisp/ffap.el b/lisp/ffap.el
index e60478c0b26..bf035886006 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1,4 +1,4 @@
-;;; ffap.el --- find file (or url) at point
+;;; ffap.el --- find file (or url) at point -*- lexical-binding: t -*-
;; Copyright (C) 1995-1997, 2000-2020 Free Software Foundation, Inc.
@@ -54,6 +54,8 @@
;; C-x 5 r ffap-read-only-other-frame
;; C-x 5 d ffap-dired-other-frame
;;
+;; C-x t f ffap-other-tab
+;;
;; S-mouse-3 ffap-at-mouse
;; C-S-mouse-3 ffap-menu
;;
@@ -108,8 +110,6 @@
(require 'url-parse)
(require 'thingatpt)
-(define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2")
-
(defgroup ffap nil
"Find file or URL at point."
:group 'matching
@@ -1049,22 +1049,19 @@ out of NAME."
"/pub/gnu/emacs/elisp-archive/"))
(substring name 2))))
-(defcustom ffap-rfc-path
- (concat (ffap-host-to-filename "ftp.rfc-editor.org") "/in-notes/rfc%s.txt")
+(defcustom ffap-rfc-path "https://www.rfc-editor.org/in-notes/rfc%s.txt"
"A `format' string making a filename for RFC documents.
-This can be an ange-ftp or Tramp remote filename to download, or
-a local filename if you have full set of RFCs locally. See also
-`ffap-rfc-directories'."
+This can be an URL, an ange-ftp or Tramp remote filename to
+download, or a local filename if you have the full set of RFCs
+locally. See also `ffap-rfc-directories'."
:type 'string
- :version "23.1"
- :group 'ffap)
+ :version "28.1")
(defcustom ffap-rfc-directories nil
"A list of directories to look for RFC files.
If a given RFC isn't in these then `ffap-rfc-path' is offered."
:type '(repeat directory)
- :version "23.1"
- :group 'ffap)
+ :version "23.1")
(defun ffap-rfc (name)
(let ((num (match-string 1 name)))
@@ -1080,7 +1077,7 @@ If a given RFC isn't in these then `ffap-rfc-path' is offered."
;; Slightly controversial decisions:
;; * strip trailing "@", ":" and enclosing "{"/"}".
;; * no commas (good for latex)
- (file "--:\\\\${}+<>@-Z_[:alpha:]~*?" "{<@" "@>;.,!:}")
+ (file "--:\\\\${}+<>@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}")
;; An url, or maybe an email/news message-id:
(url "--:=&?$+@-Z_[:alpha:]~#,%;*()!'" "^[0-9a-zA-Z]" ":;.,!?")
;; Find a string that does *not* contain a colon:
@@ -1107,6 +1104,121 @@ The arguments CHARS, BEG and END are handled as described in
;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
"Last string returned by the function `ffap-string-at-point'.")
+(defcustom ffap-file-name-with-spaces nil
+ "If non-nil, enable looking for paths with spaces in `ffap-string-at-point'.
+Enabling this variable may lead to `find-file-at-point' guessing
+wrong more often when trying to find a file name intermingled
+with normal text, but can be useful when working on systems that
+normally use spaces in file names (like Microsoft Windows and the
+like)."
+ :type 'boolean
+ :version "28.1")
+
+(defun ffap-search-backward-file-end (&optional dir-separator end)
+ "Search backward position point where file would probably end.
+Optional DIR-SEPARATOR defaults to \"/\". The search maximum is
+`line-end-position' or optional END point.
+
+Suppose the cursor is somewhere that might be near end of file,
+the guessing would position point before punctuation (like comma)
+after the file extension:
+
+ C:\temp\file.log, which contain ....
+ =============================== (before)
+ ---------------- (after)
+
+
+ C:\temp\file.log on Windows or /tmp/file.log on Unix
+ =============================== (before)
+ ---------------- (after)
+
+The strategy is to search backward until DIR-SEPARATOR which defaults to
+\"/\" and then take educated guesses.
+
+Move point and return point if an adjustment was done."
+ (unless dir-separator
+ (setq dir-separator "/"))
+ (let ((opoint (point))
+ point punct whitespace-p)
+ (when (re-search-backward
+ (regexp-quote dir-separator) (line-beginning-position) t)
+ ;; Move to the beginning of the match..
+ (forward-char 1)
+ ;; ... until typical punctuation.
+ (when (re-search-forward "\\([][<>()\"'`,.:;]\\)"
+ (or end
+ (line-end-position))
+ t)
+ (setq end (match-end 0))
+ (setq punct (match-string 1))
+ (setq whitespace-p (looking-at "[ \t\r\n]\\|$"))
+ (goto-char end)
+ (cond
+ ((and (string-equal punct ".")
+ whitespace-p) ;end of sentence
+ (setq point (1- (point))))
+ ((and (string-equal punct ".")
+ (looking-at "[a-zA-Z0-9.]+")) ;possibly file extension
+ (setq point (match-end 0)))
+ (t
+ (setq point (point)))))
+ (goto-char opoint)
+ (when point
+ (goto-char point)
+ point))))
+
+(defun ffap-search-forward-file-end (&optional dir-separator)
+ "Search DIR-SEPARATOR and position point at file's maximum ending.
+This includes spaces.
+Optional DIR-SEPARATOR defaults to \"/\".
+Call `ffap-search-backward-file-end' to refine the ending point."
+ (unless dir-separator
+ (setq dir-separator "/"))
+ (let* ((chars ;expected chars in file name
+ (concat "[^][^<>()\"'`;,#*|"
+ ;; exclude the opposite as we know the separator
+ (if (string-equal dir-separator "/")
+ "\\\\"
+ "/")
+ "\t\r\n]"))
+ (re (concat
+ chars "*"
+ (if dir-separator
+ (regexp-quote dir-separator)
+ "/")
+ chars "*")))
+ (when (looking-at re)
+ (goto-char (match-end 0)))))
+
+(defun ffap-dir-separator-near-point ()
+ "Search backward and forward for closest slash or backlash in line.
+Return string slash or backslash. Point is moved to closest position."
+ (let ((point (point))
+ str pos)
+ (when (looking-at ".*?/")
+ (setq str "/"
+ pos (match-end 0)))
+ (when (and (looking-at ".*?\\\\")
+ (or (null pos)
+ (< (match-end 0) pos)))
+ (setq str "\\"
+ pos (match-end 0)))
+ (goto-char point)
+ (when (and (re-search-backward "/" (line-beginning-position) t)
+ (or (null pos)
+ (< (- point (point)) (- pos point))))
+ (setq str "/"
+ pos (1+ (point)))) ;1+ to keep cursor at the end of char
+ (goto-char point)
+ (when (and (re-search-backward "\\\\" (line-beginning-position) t)
+ (or (null pos)
+ (< (- point (point)) (- pos point))))
+ (setq str "\\"
+ pos (1+ (point))))
+ (when pos
+ (goto-char pos))
+ str))
+
(defun ffap-string-at-point (&optional mode)
"Return a string of characters from around point.
@@ -1126,7 +1238,8 @@ Set the variables `ffap-string-at-point' and
When the region is active and larger than `ffap-max-region-length',
return an empty string, and set `ffap-string-at-point-region' to '(1 1)."
- (let* ((args
+ (let* (dir-separator
+ (args
(cdr
(or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
(assq 'file ffap-string-at-point-mode-alist))))
@@ -1135,14 +1248,25 @@ return an empty string, and set `ffap-string-at-point-region' to '(1 1)."
(beg (if region-selected
(region-beginning)
(save-excursion
- (skip-chars-backward (car args))
- (skip-chars-forward (nth 1 args) pt)
+ (if (and ffap-file-name-with-spaces
+ (memq mode '(nil file)))
+ (when (setq dir-separator (ffap-dir-separator-near-point))
+ (while (re-search-backward
+ (regexp-quote dir-separator)
+ (line-beginning-position) t)
+ (goto-char (match-beginning 0))))
+ (skip-chars-backward (car args))
+ (skip-chars-forward (nth 1 args) pt))
(point))))
(end (if region-selected
(region-end)
(save-excursion
(skip-chars-forward (car args))
(skip-chars-backward (nth 2 args) pt)
+ (when (and ffap-file-name-with-spaces
+ (memq mode '(nil file)))
+ (ffap-search-forward-file-end dir-separator)
+ (ffap-search-backward-file-end dir-separator))
(point))))
(region-len (- (max beg end) (min beg end))))
@@ -1236,12 +1360,14 @@ Set to nil to disable matching gopher bookmarks.")
(defun ffap--gopher-var-on-line ()
"Return (KEY . VALUE) of gopher bookmark on current line."
(save-excursion
- (let ((eol (progn (end-of-line) (skip-chars-backward " ") (point)))
- (bol (progn (beginning-of-line) (point))))
- (when (re-search-forward ffap-gopher-regexp eol t)
- (let ((key (match-string 1))
- (val (buffer-substring-no-properties (match-end 0) eol)))
- (cons (intern (downcase key)) val))))))
+ (end-of-line)
+ (skip-chars-backward " ")
+ (let ((eol (point)))
+ (beginning-of-line)
+ (when (re-search-forward ffap-gopher-regexp eol t)
+ (let ((key (match-string 1))
+ (val (buffer-substring-no-properties (match-end 0) eol)))
+ (cons (intern (downcase key)) val))))))
(defun ffap-gopher-at-point ()
"If point is inside a gopher bookmark block, return its URL.
@@ -1256,7 +1382,8 @@ Sets the variable `ffap-string-at-point-region' to the bounds of URL, if any."
(point)))
(bookmark (cl-loop for keyval = (ffap--gopher-var-on-line)
while keyval collect keyval
- do (forward-line 1))))
+ do (forward-line 1)
+ until (eobp))))
(when bookmark
(setq ffap-string-at-point-region (list beg (point)))
(let-alist (nconc bookmark '((type . "1") (port . "70")))
@@ -1607,7 +1734,7 @@ Each ALIST entry looks like (STRING . DATA) and defines one choice.
Function CONT is applied to the entry chosen by the user."
;; Note: this function is used with a different continuation
;; by the ffap-url add-on package.
- ;; Could try rewriting to use easymenu.el or lmenu.el.
+ ;; Could try rewriting to use easymenu.el.
(let (choice)
(cond
;; Emacs mouse:
@@ -1624,7 +1751,7 @@ Function CONT is applied to the entry chosen by the user."
;; Bug: prompting may assume unique strings, no "".
(setq choice
(completing-read
- (format "%s (default %s): " title (car (car alist)))
+ (format-prompt title (car (car alist)))
alist nil t
;; (cons (car (car alist)) 0)
nil)))
@@ -1758,6 +1885,14 @@ Only intended for interactive use."
(set-window-dedicated-p win wdp))
value))
+(defun ffap-other-tab (filename)
+ "Like `ffap', but put buffer in another tab.
+Only intended for interactive use."
+ (interactive (list (ffap-prompter nil " other tab")))
+ (pcase (save-window-excursion (find-file-at-point filename))
+ ((or (and (pred bufferp) b) `(,(and (pred bufferp) b) . ,_))
+ (switch-to-buffer-other-tab b))))
+
(defun ffap--toggle-read-only (buffer-or-list)
(dolist (buffer (if (listp buffer-or-list)
buffer-or-list
@@ -1791,6 +1926,14 @@ Only intended for interactive use."
(ffap--toggle-read-only value)
value))
+(defun ffap-read-only-other-tab (filename)
+ "Like `ffap', but put buffer in another tab and mark as read-only.
+Only intended for interactive use."
+ (interactive (list (ffap-prompter nil " read only other tab")))
+ (let ((value (window-buffer (ffap-other-tab filename))))
+ (ffap--toggle-read-only value)
+ value))
+
(defun ffap-alternate-file (filename)
"Like `ffap' and `find-alternate-file'.
Only intended for interactive use."
@@ -1815,12 +1958,6 @@ Only intended for interactive use."
(defalias 'find-file-literally-at-point 'ffap-literally)
-;;; Bug Reporter:
-
-(define-obsolete-function-alias 'ffap-bug 'report-emacs-bug "23.1")
-(define-obsolete-function-alias 'ffap-submit-bug 'report-emacs-bug "23.1")
-
-
;;; Hooks for Gnus, VM, Rmail:
;;
;; If you do not like these bindings, write versions with whatever
@@ -2013,6 +2150,7 @@ This hook is intended to be put in `file-name-at-point-functions'."
(global-set-key [remap find-file-other-window] 'ffap-other-window)
(global-set-key [remap find-file-other-frame] 'ffap-other-frame)
+ (global-set-key [remap find-file-other-tab] 'ffap-other-tab)
(global-set-key [remap find-file-read-only-other-window] 'ffap-read-only-other-window)
(global-set-key [remap find-file-read-only-other-frame] 'ffap-read-only-other-frame)
diff --git a/lisp/filecache.el b/lisp/filecache.el
index b2d3bea8aaf..00c53138032 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -614,9 +614,6 @@ the name is considered already unique; only the second substitution
(select-window (active-minibuffer-window))
(file-cache-minibuffer-complete nil)))
-(define-obsolete-function-alias 'file-cache-mouse-choose-completion
- #'file-cache-choose-completion "23.2")
-
(defun file-cache-complete ()
"Complete the word at point, using the filecache."
(interactive)
diff --git a/lisp/fileloop.el b/lisp/fileloop.el
index 668b9d4cd16..b778eca8e9b 100644
--- a/lisp/fileloop.el
+++ b/lisp/fileloop.el
@@ -4,18 +4,20 @@
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; This program is free software; you can redistribute it and/or modify
+;; 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.
-;; This program is distributed in the hope that it will be useful,
+;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -204,30 +206,34 @@ operating on the next file and nil otherwise."
;;;###autoload
(defun fileloop-initialize-replace (from to files case-fold &optional delimited)
"Initialize a new round of query&replace on several files.
- FROM is a regexp and TO is the replacement to use.
- FILES describes the files, as in `fileloop-initialize'.
- CASE-FOLD can be t, nil, or `default':
- if it is nil, matching of FROM is case-sensitive.
- if it is t, matching of FROM is case-insensitive, except
- when `search-upper-case' is non-nil and FROM includes
- upper-case letters.
- if it is `default', the function uses the value of
- `case-fold-search' instead.
- DELIMITED if non-nil means replace only word-delimited matches."
+FROM is a regexp and TO is the replacement to use.
+FILES describes the files, as in `fileloop-initialize'.
+CASE-FOLD can be t, nil, or `default':
+ if it is nil, matching of FROM is case-sensitive.
+ if it is t, matching of FROM is case-insensitive, except
+ when `search-upper-case' is non-nil and FROM includes
+ upper-case letters.
+ if it is `default', the function uses the value of
+ `case-fold-search' instead.
+DELIMITED if non-nil means replace only word-delimited matches."
;; FIXME: Not sure how the delimited-flag interacts with the regexp-flag in
;; `perform-replace', so I just try to mimic the old code.
- (fileloop-initialize
- files
- (lambda ()
- (let ((case-fold-search (fileloop--case-fold from case-fold)))
- (if (re-search-forward from nil t)
- ;; When we find a match, move back
- ;; to the beginning of it so perform-replace
- ;; will see it.
- (goto-char (match-beginning 0)))))
- (lambda ()
- (let ((case-fold-search (fileloop--case-fold from case-fold)))
- (perform-replace from to t t delimited nil multi-query-replace-map)))))
+ (let ((mstart (make-hash-table :test 'eq)))
+ (fileloop-initialize
+ files
+ (lambda ()
+ (let ((case-fold-search (fileloop--case-fold from case-fold)))
+ (when (re-search-forward from nil t)
+ ;; When we find a match, save its beginning for
+ ;; `perform-replace' (we used to just set point, but this
+ ;; is unreliable in the face of
+ ;; `switch-to-buffer-preserve-window-point').
+ (puthash (current-buffer) (match-beginning 0) mstart))))
+ (lambda ()
+ (let ((case-fold-search (fileloop--case-fold from case-fold)))
+ (perform-replace from to t t delimited nil multi-query-replace-map
+ (gethash (current-buffer) mstart (point-min))
+ (point-max)))))))
(provide 'fileloop)
;;; fileloop.el ends here
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 5d863626fa5..911e7ba9e3d 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -45,9 +45,7 @@ Intended to be used in the `interactive' spec of
(symbol-name default)))
(variable
(completing-read
- (if default
- (format "%s (default %s): " prompt default)
- (format "%s: " prompt))
+ (format-prompt prompt default)
obarray
(lambda (sym)
(or (custom-variable-p sym)
@@ -65,9 +63,7 @@ Intended to be used in the `interactive' spec of
(let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
(value
(completing-read
- (if default
- (format "Add %s with value (default %s): " variable default)
- (format "Add %s with value: " variable))
+ (format-prompt "Add %s with value" default variable)
obarray
(lambda (sym)
(string-match-p "-mode\\'" (symbol-name sym)))
@@ -79,11 +75,8 @@ Intended to be used in the `interactive' spec of
((eq variable 'coding)
(let ((default (and (symbolp buffer-file-coding-system)
(symbol-name buffer-file-coding-system))))
- (read-coding-system
- (if default
- (format "Add %s with value (default %s): " variable default)
- (format "Add %s with value: " variable))
- default)))
+ (read-coding-system (format-prompt "Add %s with value" default variable)
+ default)))
(t
(let ((default (format "%S"
(cond ((eq variable 'unibyte) t)
@@ -102,9 +95,7 @@ Intended to be used in the `interactive' spec of
(let* ((default (and (symbolp major-mode) (symbol-name major-mode)))
(mode
(completing-read
- (if default
- (format "Mode or subdirectory (default %s): " default)
- (format "Mode or subdirectory: "))
+ (format-prompt "Mode or subdirectory" default)
obarray
(lambda (sym)
(and (string-match-p "-mode\\'" (symbol-name sym))
diff --git a/lisp/files.el b/lisp/files.el
index 3e4ad7c0d44..deb878cf418 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -405,7 +405,7 @@ editing a remote file.
On MS-DOS filesystems without long names this variable is always
ignored."
:group 'auto-save
- :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")
+ :type '(repeat (list (regexp :tag "Regexp") (string :tag "Replacement")
(boolean :tag "Uniquify")))
:initialize 'custom-initialize-delay
:version "21.1")
@@ -430,7 +430,13 @@ idle for `auto-save-visited-interval' seconds."
Unlike `auto-save-mode', this mode will auto-save buffer contents
to the visited files directly and will also run all save-related
-hooks. See Info node `Saving' for details of the save process."
+hooks. See Info node `Saving' for details of the save process.
+
+You can also set the buffer-local value of the variable
+`auto-save-visited-mode' to nil. A buffer where the buffer-local
+value of this variable is nil is ignored for the purpose of
+`auto-save-visited-mode', even if `auto-save-visited-mode' is
+enabled."
:group 'auto-save
:global t
(when auto-save--timer (cancel-timer auto-save--timer))
@@ -441,6 +447,7 @@ hooks. See Info node `Saving' for details of the save process."
#'save-some-buffers :no-prompt
(lambda ()
(and buffer-file-name
+ auto-save-visited-mode
(not (and buffer-auto-save-file-name
auto-save-visited-file-name))))))))
@@ -745,10 +752,16 @@ resulting list of directory names. For an empty path element (i.e.,
a leading or trailing separator, or two adjacent separators), return
nil (meaning `default-directory') as the associated list element."
(when (stringp search-path)
- (mapcar (lambda (f)
- (if (equal "" f) nil
- (substitute-in-file-name (file-name-as-directory f))))
- (split-string search-path path-separator))))
+ (let ((spath (substitute-env-vars search-path)))
+ (mapcar (lambda (f)
+ (if (equal "" f) nil
+ (let ((dir (expand-file-name (file-name-as-directory f))))
+ ;; Previous implementation used `substitute-in-file-name'
+ ;; which collapse multiple "/" in front. Do the same for
+ ;; backward compatibility.
+ (if (string-match "\\`/+" dir)
+ (substring dir (1- (match-end 0))) dir))))
+ (split-string spath path-separator)))))
(defun cd-absolute (dir)
"Change current directory to given absolute file name DIR."
@@ -875,6 +888,16 @@ recursion."
(push (concat dir "/" file) files)))))
(nconc result (nreverse files))))
+(defun directory-empty-p (dir)
+ "Return t if DIR names an existing directory containing no other files.
+Return nil if DIR does not name a directory, or if there was
+trouble determining whether DIR is a directory or empty.
+
+Symbolic links to directories count as directories.
+See `file-symlink-p' to distinguish symlinks."
+ (and (file-directory-p dir)
+ (null (directory-files dir nil directory-files-no-dot-files-regexp t 1))))
+
(defvar module-file-suffix)
(defun load-file (file)
@@ -972,14 +995,6 @@ one or more of those symbols."
(completion-table-with-context
string-dir names string-file pred action)))))
-(defun locate-file-completion (string path-and-suffixes action)
- "Do completion for file names passed to `locate-file'.
-PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
- (declare (obsolete locate-file-completion-table "23.1"))
- (locate-file-completion-table (car path-and-suffixes)
- (cdr path-and-suffixes)
- string nil action))
-
(defvar locate-dominating-stop-dir-regexp
(purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'")
"Regexp of directory names that stop the search in `locate-dominating-file'.
@@ -1094,6 +1109,8 @@ REMOTE is non-nil, search on the remote host indicated by
(let ((default-directory (file-name-quote default-directory 'top)))
(locate-file command exec-path exec-suffixes 1))))
+(declare-function read-library-name "find-func" nil)
+
(defun load-library (library)
"Load the Emacs Lisp library named LIBRARY.
LIBRARY should be a string.
@@ -1103,12 +1120,7 @@ well as `load-file-rep-suffixes').
See Info node `(emacs)Lisp Libraries' for more details.
See `load-file' for a different interface to `load'."
- (interactive
- (let (completion-ignored-extensions)
- (list (completing-read "Load library: "
- (apply-partially 'locate-file-completion-table
- load-path
- (get-load-suffixes))))))
+ (interactive (list (read-library-name)))
(load library))
(defun file-remote-p (file &optional identification connected)
@@ -1390,7 +1402,7 @@ it means chase no more than that many links and then stop."
newname))
;; A handy function to display file sizes in human-readable form.
-;; See http://en.wikipedia.org/wiki/Kibibyte for the reference.
+;; See https://en.wikipedia.org/wiki/Kibibyte for the reference.
(defun file-size-human-readable (file-size &optional flavor space unit)
"Produce a string showing FILE-SIZE in human-readable form.
@@ -1561,8 +1573,8 @@ use with M-x."
(and (not (memq 'eight-bit-control charsets))
(not (memq 'eight-bit-graphic charsets)))))
(setq from-coding (read-coding-system
- (format "Recode filename %s from (default %s): "
- filename default-coding)
+ (format-prompt "Recode filename %s from"
+ filename default-coding)
default-coding))
(setq from-coding (read-coding-system
(format "Recode filename %s from: " filename))))
@@ -1574,8 +1586,8 @@ use with M-x."
(format "Recode filename %s from %s to: "
filename from-coding)))
(setq to-coding (read-coding-system
- (format "Recode filename %s from %s to (default %s): "
- filename from-coding default-coding)
+ (format-prompt "Recode filename %s from %s to"
+ default-coding filename from-coding)
default-coding)))
(list filename from-coding to-coding)))
@@ -1917,6 +1929,8 @@ killed."
(setq buffer-file-truename otrue)
(setq dired-directory odir)
(lock-buffer)
+ (if (get-buffer oname)
+ (kill-buffer oname))
(rename-buffer oname)))
(unless (eq (current-buffer) obuf)
(with-current-buffer obuf
@@ -2660,6 +2674,13 @@ since only a single case-insensitive search through the alist is made."
("\\.ltx\\'" . latex-mode)
("\\.dtx\\'" . doctex-mode)
("\\.org\\'" . org-mode)
+ ;; .dir-locals.el is not really Elisp. Could use the
+ ;; `dir-locals-file' constant if it weren't defined below.
+ ("\\.dir-locals\\(?:-2\\)?\\.el\\'" . lisp-data-mode)
+ ("eww-bookmarks\\'" . lisp-data-mode)
+ ("tramp\\'" . lisp-data-mode)
+ ("places\\'" . lisp-data-mode)
+ ("\\.emacs-places\\'" . lisp-data-mode)
("\\.el\\'" . emacs-lisp-mode)
("Project\\.ede\\'" . emacs-lisp-mode)
("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
@@ -2670,8 +2691,6 @@ since only a single case-insensitive search through the alist is made."
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode)
- ("\\.ad[abs]\\'" . ada-mode)
- ("\\.ad[bs]\\.dg\\'" . ada-mode)
("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
("Imakefile\\'" . makefile-imake-mode)
("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk
@@ -2749,8 +2768,8 @@ since only a single case-insensitive search through the alist is made."
;; The list of archive file extensions should be in sync with
;; `auto-coding-alist' with `no-conversion' coding system.
("\\.\\(\
-arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|\
-ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mode)
+arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|squashfs\\|\
+ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . archive-mode)
("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions.
("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages.
;; Mailer puts message to be edited in
@@ -3058,7 +3077,7 @@ If FUNCTION is nil, then it is not called. (That is a way of saying
"\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?"
"[Hh][Tt][Mm][Ll]"))
. mhtml-mode)
- ("<!DOCTYPE[ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode)
+ ("<![Dd][Oo][Cc][Tt][Yy][Pp][Ee][ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode)
;; These two must come after html, because they are more general:
("<\\?xml " . xml-mode)
(,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
@@ -4292,9 +4311,27 @@ Return the new class name, which is a symbol named DIR."
(if (not (and newvars variables))
(or newvars variables)
(require 'map)
- (map-merge-with 'list (lambda (a b) (map-merge 'list a b))
- variables
- newvars))))))
+ ;; We want to make the variable setting from
+ ;; newvars (the second .dir-locals file) take
+ ;; presedence over the old variables, but we also
+ ;; want to preserve all `eval' elements as is from
+ ;; both lists.
+ (map-merge-with
+ 'list
+ (lambda (a b)
+ (let ((ag
+ (seq-group-by
+ (lambda (e) (eq (car e) 'eval)) a))
+ (bg
+ (seq-group-by
+ (lambda (e) (eq (car e) 'eval)) b)))
+ (append (map-merge 'list
+ (assoc-default nil ag)
+ (assoc-default nil bg))
+ (assoc-default t ag)
+ (assoc-default t bg))))
+ variables
+ newvars))))))
(setq success latest))
(setq variables (dir-locals--sort-variables variables))
(dir-locals-set-class-variables class-name variables)
@@ -4674,6 +4711,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
+ (let (nofollow-flag)
(with-file-modes ?\700
(when (condition-case nil
;; Try to overwrite old backup first.
@@ -4684,6 +4722,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
(when (file-exists-p to-name)
(delete-file to-name))
(copy-file from-name to-name nil t t)
+ (setq nofollow-flag 'nofollow)
nil)
(file-already-exists t))
;; The file was somehow created by someone else between
@@ -4696,7 +4735,7 @@ BACKUPNAME is the backup file name, which is the old file renamed."
(with-demoted-errors
(set-file-extended-attributes to-name extended-attributes)))
(and modes
- (set-file-modes to-name (logand modes #o1777)))))
+ (set-file-modes to-name (logand modes #o1777) nofollow-flag)))))
(defvar file-name-version-regexp
"\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)"
@@ -5555,10 +5594,28 @@ change the additional actions you can take on files."
t
(setq queried t)
(if (buffer-file-name buffer)
- (format "Save file %s? "
- (buffer-file-name buffer))
- (format "Save buffer %s? "
- (buffer-name buffer))))))
+ (if (or
+ (equal (buffer-name buffer)
+ (file-name-nondirectory
+ (buffer-file-name buffer)))
+ (string-match
+ (concat "\\<"
+ (regexp-quote
+ (file-name-nondirectory
+ (buffer-file-name buffer)))
+ "<[^>]*>\\'")
+ (buffer-name buffer)))
+ ;; The buffer name is similar to the
+ ;; file name.
+ (format "Save file %s? "
+ (buffer-file-name buffer))
+ ;; The buffer and file names are
+ ;; dissimilar; display both.
+ (format "Save file %s (buffer %s)? "
+ (buffer-file-name buffer)
+ (buffer-name buffer)))
+ ;; No file name
+ (format "Save buffer %s? " (buffer-name buffer))))))
(lambda (buffer)
(with-current-buffer buffer
(save-buffer)))
@@ -5644,25 +5701,28 @@ like `write-region' does."
(defun file-newest-backup (filename)
"Return most recent backup file for FILENAME or nil if no backups exist."
+ (car (file-backup-file-names filename)))
+
+(defun file-backup-file-names (filename)
+ "Return a list of backup files for FILENAME.
+The list will be sorted by modification time so that the most
+recent files are first."
;; `make-backup-file-name' will get us the right directory for
;; ordinary or numeric backups. It might create a directory for
;; backups as a side-effect, according to `backup-directory-alist'.
(let* ((filename (file-name-sans-versions
(make-backup-file-name (expand-file-name filename))))
- (file (file-name-nondirectory filename))
- (dir (file-name-directory filename))
- (comp (file-name-all-completions file dir))
- (newest nil)
- tem)
- (while comp
- (setq tem (pop comp))
- (cond ((and (backup-file-name-p tem)
- (string= (file-name-sans-versions tem) file))
- (setq tem (concat dir tem))
- (if (or (null newest)
- (file-newer-than-file-p tem newest))
- (setq newest tem)))))
- newest))
+ (dir (file-name-directory filename)))
+ (sort
+ (seq-filter
+ (lambda (candidate)
+ (and (backup-file-name-p candidate)
+ (string= (file-name-sans-versions candidate) filename)))
+ (mapcar
+ (lambda (file)
+ (concat dir file))
+ (file-name-all-completions (file-name-nondirectory filename) dir)))
+ #'file-newer-than-file-p)))
(defun rename-uniquely ()
"Rename current buffer to a similar name not already taken.
@@ -5755,7 +5815,10 @@ If called interactively, then PARENTS is non-nil."
(defconst directory-files-no-dot-files-regexp
"[^.]\\|\\.\\.\\."
- "Regexp matching any file name except \".\" and \"..\".")
+ "Regexp matching any file name except \".\" and \"..\".
+More precisely, it matches parts of any nonempty string except those two.
+It is useful as the regexp argument to `directory-files' and
+`directory-files-and-attributes'.")
(defun files--force (no-such fn &rest args)
"Use NO-SUCH to affect behavior of function FN applied to list ARGS.
@@ -5804,10 +5867,7 @@ RECURSIVE if DIRECTORY is nonempty."
;; case, where the operation fails in delete-directory-internal.
;; As `move-file-to-trash' trashes directories (empty or
;; otherwise) as a unit, we do not need to recurse here.
- (if (and (not recursive)
- ;; Check if directory is empty apart from "." and "..".
- (directory-files
- directory 'full directory-files-no-dot-files-regexp))
+ (if (not (or recursive (directory-empty-p directory)))
(error "Directory is not empty, not moving to trash")
(move-file-to-trash directory)))
;; Otherwise, call ourselves recursively if needed.
@@ -5880,9 +5940,9 @@ last-modified time as the old ones. (This works on only some systems.)
A prefix arg makes KEEP-TIME non-nil.
-Noninteractively, the last argument PARENTS says whether to
-create parent directories if they don't exist. Interactively,
-this happens by default.
+Noninteractively, the PARENTS argument says whether to create
+parent directories if they don't exist. Interactively, this
+happens by default.
If NEWNAME is a directory name, copy DIRECTORY as a subdirectory
there. However, if called from Lisp with a non-nil optional
@@ -5902,7 +5962,8 @@ into NEWNAME instead."
;; If default-directory is a remote directory, make sure we find its
;; copy-directory handler.
(let ((handler (or (find-file-name-handler directory 'copy-directory)
- (find-file-name-handler newname 'copy-directory))))
+ (find-file-name-handler newname 'copy-directory)))
+ (follow parents))
(if handler
(funcall handler 'copy-directory directory
newname keep-time parents copy-contents)
@@ -5922,7 +5983,8 @@ into NEWNAME instead."
(or parents (not (file-directory-p newname)))
(setq newname (concat newname
(file-name-nondirectory directory))))
- (make-directory (directory-file-name newname) parents)))
+ (make-directory (directory-file-name newname) parents))
+ (t (setq follow t)))
;; Copy recursively.
(dolist (file
@@ -5942,9 +6004,10 @@ into NEWNAME instead."
;; Set directory attributes.
(let ((modes (file-modes directory))
(times (and keep-time (file-attribute-modification-time
- (file-attributes directory)))))
- (if modes (set-file-modes newname modes))
- (if times (set-file-times newname times))))))
+ (file-attributes directory))))
+ (follow-flag (unless follow 'nofollow)))
+ (if modes (set-file-modes newname modes follow-flag))
+ (if times (set-file-times newname times follow-flag))))))
;; At time of writing, only info uses this.
@@ -6216,6 +6279,82 @@ an auto-save file."
(insert-file-contents file-name (not auto-save-p)
nil nil t))))))
+(defvar revert-buffer-with-fine-grain-max-seconds 2.0
+ "Maximum time that `revert-buffer-with-fine-grain' should use.
+The command tries to preserve markers, properties and overlays.
+If the operation takes more than this time, a single
+delete+insert is performed. Actually, this value is passed as
+the MAX-SECS argument to the function `replace-buffer-contents',
+so it is not ensured that the whole execution won't take longer.
+See `replace-buffer-contents' for more details.")
+
+(defun revert-buffer-insert-file-contents-delicately (file-name _auto-save-p)
+ "Optional function for `revert-buffer-insert-file-contents-function'.
+The function `revert-buffer-with-fine-grain' uses this function by binding
+`revert-buffer-insert-file-contents-function' to it.
+
+As with `revert-buffer-insert-file-contents--default-function', FILE-NAME is
+the name of the file and AUTO-SAVE-P is non-nil if this is an auto-save file.
+Since calling `replace-buffer-contents' can take a long time, depending of
+the number of changes made to the buffer, it uses the value of the variable
+`revert-buffer-with-fine-grain-max-seconds' as a maximum time to try delicately
+reverting the buffer. If it fails, it does a delete+insert. For more details,
+see `replace-buffer-contents'."
+ (cond
+ ((not (file-exists-p file-name))
+ (error (if buffer-file-number
+ "File %s no longer exists"
+ "Cannot revert nonexistent file %s")
+ file-name))
+ ((not (file-readable-p file-name))
+ (error (if buffer-file-number
+ "File %s no longer readable"
+ "Cannot revert unreadable file %s")
+ file-name))
+ (t
+ (let* ((buf (current-buffer)) ; current-buffer is the buffer to revert.
+ (success
+ (save-excursion
+ (save-restriction
+ (widen)
+ (with-temp-buffer
+ (insert-file-contents file-name)
+ (let ((temp-buf (current-buffer)))
+ (set-buffer buf)
+ (let ((buffer-file-name nil))
+ (replace-buffer-contents
+ temp-buf
+ revert-buffer-with-fine-grain-max-seconds))))))))
+ ;; See comments in revert-buffer-with-fine-grain for an explanation.
+ (defun revert-buffer-with-fine-grain-success-p ()
+ success))
+ (set-buffer-modified-p nil))))
+
+(defun revert-buffer-with-fine-grain (&optional ignore-auto noconfirm)
+ "Revert buffer preserving markers, overlays, etc.
+This command is an alternative to `revert-buffer' because it tries to be as
+non-destructive as possible, preserving markers, properties and overlays.
+Binds `revert-buffer-insert-file-contents-function' to the function
+`revert-buffer-insert-file-contents-delicately'.
+
+With a prefix argument, offer to revert from latest auto-save file. For more
+details on the arguments, see `revert-buffer'."
+ ;; See revert-buffer for an explanation of this.
+ (interactive (list (not current-prefix-arg)))
+ ;; Simply bind revert-buffer-insert-file-contents-function to the specialized
+ ;; function, and call revert-buffer.
+ (let ((revert-buffer-insert-file-contents-function
+ #'revert-buffer-insert-file-contents-delicately))
+ (revert-buffer ignore-auto noconfirm t)
+ ;; This closure is defined in revert-buffer-insert-file-contents-function.
+ ;; It is needed because revert-buffer--default always returns t after
+ ;; reverting, and it might be needed to report the success/failure of
+ ;; reverting delicately.
+ (when (fboundp 'revert-buffer-with-fine-grain-success-p)
+ (prog1
+ (revert-buffer-with-fine-grain-success-p)
+ (fmakunbound 'revert-buffer-with-fine-grain-success-p)))))
+
(defun recover-this-file ()
"Recover the visited file--get contents from its last auto-save file."
(interactive)
@@ -6445,7 +6584,7 @@ Also rename any existing auto save file, if it was made in this session."
(defun make-auto-save-file-name ()
"Return file name to use for auto-saves of current buffer.
Does not consider `auto-save-visited-file-name' as that variable is checked
-before calling this function. You can redefine this for customization.
+before calling this function.
See also `auto-save-file-name-p'."
(if buffer-file-name
(let ((handler (find-file-name-handler buffer-file-name
@@ -6552,7 +6691,8 @@ See also `auto-save-file-name-p'."
(defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
-FILENAME should lack slashes. You can redefine this for customization."
+FILENAME should lack slashes.
+See also `make-auto-save-file-name'."
(string-match "\\`#.*#\\'" filename))
(defun wildcard-to-regexp (wildcard)
@@ -6775,9 +6915,7 @@ We assume the output has the format of `df'.
The value of this variable must be just a command name or file name;
if you want to specify options, use `directory-free-space-args'.
-A value of nil disables this feature.
-
-This variable is obsolete; Emacs no longer uses it."
+A value of nil disables this feature."
:type '(choice (string :tag "Program") (const :tag "None" nil))
:group 'dired)
(make-obsolete-variable 'directory-free-space-program
@@ -6823,6 +6961,9 @@ If DIR's free space cannot be obtained, this function returns nil."
s "+"
"\\(" HH:MM "\\|" yyyy "\\)"))
(western-comma (concat month s "+" dd "," s "+" yyyy))
+ ;; This represents the date in strftime(3) format "%e-%b-%Y"
+ ;; (aka "%v"), as it is the default for many ls incarnations.
+ (DD-MMM-YYYY (concat dd "-" month "-" yyyy s HH:MM))
;; Japanese MS-Windows ls-lisp has one-digit months, and
;; omits the Kanji characters after month and day-of-month.
;; On Mac OS X 10.3, the date format in East Asian locales is
@@ -6850,7 +6991,8 @@ If DIR's free space cannot be obtained, this function returns nil."
;; This is not supported yet.
(purecopy (concat "\\([0-9][BkKMGTPEZY]? " iso
"\\|.*[0-9][BkKMGTPEZY]? "
- "\\(" western "\\|" western-comma "\\|" east-asian "\\)"
+ "\\(" western "\\|" western-comma
+ "\\|" DD-MMM-YYYY "\\|" east-asian "\\)"
"\\) +")))
"Regular expression to match up to the file name in a directory listing.
The default value is designed to recognize dates and times
@@ -7031,6 +7173,8 @@ normally equivalent short `-D' option is just passed on to
((stringp switches) (concat switches " -d"))
((member "-d" switches) switches)
(t (append switches '("-d"))))))
+ (if (string-match "\\`~" file)
+ (setq file (expand-file-name file)))
(apply 'call-process
insert-directory-program nil t nil
(append
@@ -7041,14 +7185,7 @@ normally equivalent short `-D' option is just passed on to
(split-string-and-unquote switches)))
;; Avoid lossage if FILE starts with `-'.
'("--")
- (progn
- (if (string-match "\\`~" file)
- (setq file (expand-file-name file)))
- (list
- (if full-directory-p
- ;; (concat (file-name-as-directory file) ".")
- file
- file))))))))
+ (list file))))))
;; If we got "//DIRED//" in the output, it means we got a real
;; directory listing, even if `ls' returned nonzero.
@@ -7250,10 +7387,15 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(setq active t))
(setq processes (cdr processes)))
(or (not active)
- (with-displayed-buffer-window
+ (with-current-buffer-window
(get-buffer-create "*Process List*")
- '(display-buffer--maybe-at-bottom
- (dedicated . t))
+ `(display-buffer--maybe-at-bottom
+ (dedicated . t)
+ (window-height . fit-window-to-buffer)
+ (preserve-size . (nil . t))
+ (body-function
+ . ,#'(lambda (_window)
+ (list-processes t))))
#'(lambda (window _value)
(with-selected-window window
(unwind-protect
@@ -7261,8 +7403,7 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(setq confirm nil)
(yes-or-no-p "Active processes exist; kill them and exit anyway? "))
(when (window-live-p window)
- (quit-restore-window window 'kill)))))
- (list-processes t)))))
+ (quit-restore-window window 'kill)))))))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
(or (null confirm)
@@ -7536,6 +7677,27 @@ as in \"og+rX-w\"."
op char-right)))
num-rights))
+(defun file-modes-number-to-symbolic (mode)
+ (string
+ (if (zerop (logand 8192 mode))
+ (if (zerop (logand 16384 mode)) ?- ?d)
+ ?c) ; completeness
+ (if (zerop (logand 256 mode)) ?- ?r)
+ (if (zerop (logand 128 mode)) ?- ?w)
+ (if (zerop (logand 64 mode))
+ (if (zerop (logand 2048 mode)) ?- ?S)
+ (if (zerop (logand 2048 mode)) ?x ?s))
+ (if (zerop (logand 32 mode)) ?- ?r)
+ (if (zerop (logand 16 mode)) ?- ?w)
+ (if (zerop (logand 8 mode))
+ (if (zerop (logand 1024 mode)) ?- ?S)
+ (if (zerop (logand 1024 mode)) ?x ?s))
+ (if (zerop (logand 4 mode)) ?- ?r)
+ (if (zerop (logand 2 mode)) ?- ?w)
+ (if (zerop (logand 512 mode))
+ (if (zerop (logand 1 mode)) ?- ?x)
+ (if (zerop (logand 1 mode)) ?T ?t))))
+
(defun file-modes-symbolic-to-number (modes &optional from)
"Convert symbolic file modes to numeric file modes.
MODES is the string to convert, it should match
@@ -7643,7 +7805,7 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
(let (delete-by-moving-to-trash)
(rename-file fn new-fn))))
;; Otherwise, use the freedesktop.org method, as specified at
- ;; http://freedesktop.org/wiki/Specifications/trash-spec
+ ;; https://freedesktop.org/wiki/Specifications/trash-spec
(t
(let* ((xdg-data-dir
(directory-file-name
diff --git a/lisp/filesets.el b/lisp/filesets.el
index c43c468ead3..2cad2023b85 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -35,7 +35,7 @@
;; inclusion group (i.e. a base file including other files).
;; Usage:
-;; 1. Put (require 'filesets) and (filesets-init) in your init file.
+;; 1. Put (filesets-init) in your init file.
;; 2. Type ;; M-x filesets-edit or choose "Edit Filesets" from the menu.
;; 3. Save your customizations.
@@ -1645,10 +1645,10 @@ Replace <file-name> or <<file-name>> with filename."
(dolist (this args txt)
(setq txt
(concat txt
+ (if (equal txt "") "" " ")
(filesets-run-cmd--repl-fn
this
(lambda (this)
- (if (equal txt "") "" " ")
(format "%s" this))))))))
(cmd (concat fn " " args)))
(filesets-cmd-show-result
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index a96c6c9edbb..18330d821ce 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -85,8 +85,8 @@ the options \"-dilsb\".
While the option `find -ls' often produces unsorted output, the option
`find -exec ls -ld' maintains the sorting order only on short output,
-whereas `find -print | sort | xargs' produced sorted output even
-on the large number of files."
+whereas `find -print | sort | xargs' produces sorted output even
+on a large number of files."
:version "27.1" ; add choice of predefined set of options
:type `(choice
(cons :tag "find -ls"
@@ -164,7 +164,10 @@ The command run (after changing into DIR) is essentially
find . \\( ARGS \\) -ls
except that the car of the variable `find-ls-option' specifies what to
-use in place of \"-ls\" as the final argument."
+use in place of \"-ls\" as the final argument.
+
+Collect output in the \"*Find*\" buffer. To kill the job before
+it finishes, type \\[kill-find]."
(interactive (list (read-directory-name "Run find in directory: " nil "" t)
(read-string "Run find (with args): " find-args
'(find-args-history . 1))))
@@ -215,7 +218,6 @@ use in place of \"-ls\" as the final argument."
(car find-ls-option))))
;; Start the find process.
(shell-command (concat args "&") (current-buffer))
- ;; The next statement will bomb in classic dired (no optional arg allowed)
(dired-mode dir (cdr find-ls-option))
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
@@ -247,8 +249,8 @@ use in place of \"-ls\" as the final argument."
(dired-insert-set-properties point (point)))
(setq buffer-read-only t)
(let ((proc (get-buffer-process (current-buffer))))
- (set-process-filter proc (function find-dired-filter))
- (set-process-sentinel proc (function find-dired-sentinel))
+ (set-process-filter proc #'find-dired-filter)
+ (set-process-sentinel proc #'find-dired-sentinel)
;; Initialize the process marker; it is used by the filter.
(move-marker (process-mark proc) (point) (current-buffer)))
(setq mode-line-process '(":%s"))))
@@ -258,7 +260,7 @@ use in place of \"-ls\" as the final argument."
(interactive)
(let ((find (get-buffer-process (current-buffer))))
(and find (eq (process-status find) 'run)
- (eq (process-filter find) (function find-dired-filter))
+ (eq (process-filter find) #'find-dired-filter)
(condition-case nil
(delete-process find)
(error nil)))))
diff --git a/lisp/find-file.el b/lisp/find-file.el
index 7e0127da5f2..84d02cb4a26 100644
--- a/lisp/find-file.el
+++ b/lisp/find-file.el
@@ -109,8 +109,8 @@
;; file.
;; CREDITS:
-;; Many thanks go to TUSC Computer Systems Pty Ltd for providing an environ-
-;; ment that made the development of this package possible.
+;; Many thanks go to TUSC Computer Systems Pty Ltd for providing an
+;; environment that made the development of this package possible.
;;
;; Many thanks also go to all those who provided valuable feedback throughout
;; the development of this package:
diff --git a/lisp/finder.el b/lisp/finder.el
index 5835144b069..a59a185cc9b 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -200,7 +200,7 @@ from; the default is `load-path'."
(cons d f))
(directory-files d nil el-file-regexp))))
(progress (make-progress-reporter
- (byte-compile-info-string "Scanning files for finder")
+ (byte-compile-info "Scanning files for finder")
0 (length files)))
package-override base-name ; processed
summary keywords package version entry desc)
@@ -397,13 +397,6 @@ FILE should be in a form suitable for passing to `locate-library'."
(erase-buffer)
(insert str)
(goto-char (point-min))
- (delete-blank-lines)
- (goto-char (point-max))
- (delete-blank-lines)
- (goto-char (point-min))
- (while (re-search-forward "^;+ ?" nil t)
- (replace-match "" nil nil))
- (goto-char (point-min))
(while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
(if (locate-library (match-string 1))
(make-text-button (match-beginning 1) (match-end 1)
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 0d7a7a88a6f..58455c28b16 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -527,19 +527,18 @@ Valid modifiers are shift, control, meta, alt, hyper and super.")
(define-key map "\C-z" 'foldout-zoom-subtree)
(define-key map "\C-x" 'foldout-exit-fold))
(let* ((modifiers (apply 'concat
- (mapcar (function
- (lambda (modifier)
- (vector
- (cond
- ((eq modifier 'shift) ?S)
- ((eq modifier 'control) ?C)
- ((eq modifier 'meta) ?M)
- ((eq modifier 'alt) ?A)
- ((eq modifier 'hyper) ?H)
- ((eq modifier 'super) ?s)
- (t (error "invalid mouse modifier %s"
- modifier)))
- ?-)))
+ (mapcar (lambda (modifier)
+ (vector
+ (cond
+ ((eq modifier 'shift) ?S)
+ ((eq modifier 'control) ?C)
+ ((eq modifier 'meta) ?M)
+ ((eq modifier 'alt) ?A)
+ ((eq modifier 'hyper) ?H)
+ ((eq modifier 'super) ?s)
+ (t (error "invalid mouse modifier %s"
+ modifier)))
+ ?-))
foldout-mouse-modifiers)))
(mouse-1 (vector (intern (concat modifiers "down-mouse-1"))))
(mouse-2 (vector (intern (concat modifiers "down-mouse-2"))))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 30edebb4e68..e708e69bd59 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -51,7 +51,7 @@
;; also the variable `font-lock-maximum-size'. Support modes for Font Lock
;; mode can be used to speed up Font Lock mode. See `font-lock-support-mode'.
-;;; How Font Lock mode fontifies:
+;;;; How Font Lock mode fontifies:
;; When Font Lock mode is turned on in a buffer, it (a) fontifies the entire
;; buffer and (b) installs one of its fontification functions on one of the
@@ -96,7 +96,7 @@
;; some syntactic parsers for common languages and a son-of-font-lock.el could
;; use them rather then relying so heavily on the keyword (regexp) pass.
-;;; How Font Lock mode supports modes or is supported by modes:
+;;;; How Font Lock mode supports modes or is supported by modes:
;; Modes that support Font Lock mode do so by defining one or more variables
;; whose values specify the fontification. Font Lock mode knows of these
@@ -112,7 +112,7 @@
;; Font Lock mode fontification behavior can be modified in a number of ways.
;; See the below comments and the comments distributed throughout this file.
-;;; Constructing patterns:
+;;;; Constructing patterns:
;; See the documentation for the variable `font-lock-keywords'.
;;
@@ -120,7 +120,7 @@
;; `font-lock-syntactic-keywords' can be generated via the function
;; `regexp-opt'.
-;;; Adding patterns for modes that already support Font Lock:
+;;;; Adding patterns for modes that already support Font Lock:
;; Though Font Lock highlighting patterns already exist for many modes, it's
;; likely there's something that you want fontified that currently isn't, even
@@ -135,7 +135,7 @@
;; other variables. For example, additional C types can be specified via the
;; variable `c-font-lock-extra-types'.
-;;; Adding patterns for modes that do not support Font Lock:
+;;;; Adding patterns for modes that do not support Font Lock:
;; Not all modes support Font Lock mode. If you (as a user of the mode) add
;; patterns for a new mode, you must define in your ~/.emacs a variable or
@@ -155,7 +155,7 @@
;; (set (make-local-variable 'font-lock-defaults)
;; '(foo-font-lock-keywords t))))
-;;; Adding Font Lock support for modes:
+;;;; Adding Font Lock support for modes:
;; Of course, it would be better that the mode already supports Font Lock mode.
;; The package author would do something similar to above. The mode must
@@ -575,6 +575,7 @@ This is normally set via `font-lock-defaults'.")
"Non-nil means use this syntax table for fontifying.
If this is nil, the major mode's syntax table is used.
This is normally set via `font-lock-defaults'.")
+(defvar-local font-lock--syntax-table-affects-ppss nil)
(defvar font-lock-mark-block-function nil
"Non-nil means use this function to mark a block of text.
@@ -985,7 +986,7 @@ The value of this variable is used when Font Lock mode is turned on."
((bound-and-true-p lazy-lock-mode)
(lazy-lock-after-unfontify-buffer))))
-;;; End of Font Lock Support mode.
+;; End of Font Lock Support mode.
;;; Fontification functions.
@@ -1120,9 +1121,10 @@ locking for a mode, and is not meant to be called from lisp functions."
"Make sure the region BEG...END has been fontified.
If the region is not specified, it defaults to the entire accessible
portion of the buffer."
- (font-lock-set-defaults)
- (funcall font-lock-ensure-function
- (or beg (point-min)) (or end (point-max))))
+ (when (font-lock-specified-p t)
+ (font-lock-set-defaults)
+ (funcall font-lock-ensure-function
+ (or beg (point-min)) (or end (point-max)))))
(defun font-lock-default-fontify-buffer ()
"Fontify the whole buffer using `font-lock-fontify-region-function'."
@@ -1391,7 +1393,7 @@ delimit the region to fontify."
(font-lock-fontify-region (point) (mark)))
((error quit) (message "Fontifying block...%s" error-data)))))))
-;;; End of Fontification functions.
+;; End of Fontification functions.
;;; Additional text property functions.
@@ -1483,7 +1485,7 @@ Optional argument OBJECT is the string or buffer containing the text."
(put-text-property start next prop new object))))))
(setq start (text-property-not-all next end prop nil object)))))
-;;; End of Additional text property functions.
+;; End of Additional text property functions.
;;; Syntactic regexp fontification functions.
@@ -1589,7 +1591,7 @@ START should be at the beginning of a line."
(setq highlights (cdr highlights))))
(setq keywords (cdr keywords)))))
-;;; End of Syntactic regexp fontification functions.
+;; End of Syntactic regexp fontification functions.
;;; Syntactic fontification functions.
@@ -1609,7 +1611,15 @@ START should be at the beginning of a line."
(regexp-quote
(replace-regexp-in-string "^ *" "" comment-end))))
;; Find the `start' state.
- (state (syntax-ppss start))
+ (state (if (or syntax-ppss-table
+ (not font-lock--syntax-table-affects-ppss))
+ (syntax-ppss start)
+ ;; If `syntax-ppss' doesn't have its own syntax-table and
+ ;; we have installed our own syntax-table which
+ ;; differs from the standard one in ways which affects PPSS,
+ ;; then we can't use `syntax-ppss' since that would pollute
+ ;; and be polluted by its cache.
+ (parse-partial-sexp (point-min) start)))
face beg)
(if loudly (message "Fontifying %s... (syntactically...)" (buffer-name)))
;;
@@ -1640,7 +1650,7 @@ START should be at the beginning of a line."
(setq state (parse-partial-sexp (point) end nil nil state
'syntax-table))))))
-;;; End of Syntactic fontification functions.
+;; End of Syntactic fontification functions.
;;; Keyword regexp fontification functions.
@@ -1774,9 +1784,9 @@ LOUDLY, if non-nil, allows progress-meter bar."
(setq keywords (cdr keywords)))
(set-marker pos nil)))
-;;; End of Keyword regexp fontification functions.
+;; End of Keyword regexp fontification functions.
-;; Various functions.
+;;; Various functions.
(defun font-lock-compile-keywords (keywords &optional syntactic-keywords)
"Compile KEYWORDS into the form (t KEYWORDS COMPILED...)
@@ -1906,6 +1916,7 @@ Sets various variables using `font-lock-defaults' and
;; Case fold during regexp fontification?
(setq-local font-lock-keywords-case-fold-search (nth 2 defaults))
;; Syntax table for regexp and syntactic fontification?
+ (kill-local-variable 'font-lock--syntax-table-affects-ppss)
(if (null (nth 3 defaults))
(setq-local font-lock-syntax-table nil)
(setq-local font-lock-syntax-table (copy-syntax-table (syntax-table)))
@@ -1915,7 +1926,14 @@ Sets various variables using `font-lock-defaults' and
(dolist (char (if (numberp (car selem))
(list (car selem))
(mapcar #'identity (car selem))))
- (modify-syntax-entry char syntax font-lock-syntax-table)))))
+ (unless (memq (car (aref font-lock-syntax-table char))
+ '(1 2 3)) ;"." "w" "_"
+ (setq font-lock--syntax-table-affects-ppss t))
+ (modify-syntax-entry char syntax font-lock-syntax-table)
+ (unless (memq (car (aref font-lock-syntax-table char))
+ '(1 2 3)) ;"." "w" "_"
+ (setq font-lock--syntax-table-affects-ppss t))
+ ))))
;; (nth 4 defaults) used to hold `font-lock-beginning-of-syntax-function',
;; but that was removed in 25.1, so if it's a cons cell, we assume that
;; it's part of the variable alist.
@@ -2084,7 +2102,7 @@ Sets various variables using `font-lock-defaults' and
"Font Lock mode face used to highlight grouping constructs in Lisp regexps."
:group 'font-lock-faces)
-;;; End of Color etc. support.
+;; End of Color etc. support.
;;; Menu support.
@@ -2186,7 +2204,7 @@ Sets various variables using `font-lock-defaults' and
;; ;; Deactivate less/more fontification entries.
;; (setq font-lock-fontify-level nil))
-;;; End of Menu support.
+;; End of Menu support.
;;; Various regexp information shared by several modes.
;; ;; Information specific to a single mode should go in its load library.
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index 9278bd74c42..6af79a44167 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -1,4 +1,4 @@
-;;; format-spec.el --- functions for formatting arbitrary formatting strings
+;;; format-spec.el --- format arbitrary formatting strings -*- lexical-binding: t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -24,10 +24,8 @@
;;; Code:
-(eval-when-compile
- (require 'subr-x))
-
-(defun format-spec (format specification &optional only-present)
+;;;###autoload
+(defun format-spec (format specification &optional ignore-missing)
"Return a string based on FORMAT and SPECIFICATION.
FORMAT is a string containing `format'-like specs like \"su - %u %k\".
SPECIFICATION is an alist mapping format specification characters
@@ -39,22 +37,22 @@ For instance:
\\=`((?u . ,(user-login-name))
(?l . \"ls\")))
-Each %-spec may contain optional flag and width modifiers, as
-follows:
+Each %-spec may contain optional flag, width, and precision
+modifiers, as follows:
- %<flags><width>character
+ %<flags><width><precision>character
The following flags are allowed:
* 0: Pad to the width, if given, with zeros instead of spaces.
* -: Pad to the width, if given, on the right instead of the left.
-* <: Truncate to the width, if given, on the left.
-* >: Truncate to the width, if given, on the right.
+* <: Truncate to the width and precision, if given, on the left.
+* >: Truncate to the width and precision, if given, on the right.
* ^: Convert to upper case.
* _: Convert to lower case.
-The width modifier behaves like the corresponding one in `format'
-when applied to %s.
+The width and truncation modifiers behave like the corresponding
+ones in `format' when applied to %s.
For example, \"%<010b\" means \"substitute into the output the
value associated with ?b in SPECIFICATION, either padding it with
@@ -64,89 +62,108 @@ characters wide\".
Any text properties of FORMAT are copied to the result, with any
text properties of a %-spec itself copied to its substitution.
-ONLY-PRESENT indicates how to handle %-spec characters not
+IGNORE-MISSING indicates how to handle %-spec characters not
present in SPECIFICATION. If it is nil or omitted, emit an
-error; otherwise leave those %-specs and any occurrences of
-\"%%\" in FORMAT verbatim in the result, including their text
-properties, if any."
+error; if it is the symbol `ignore', leave those %-specs verbatim
+in the result, including their text properties, if any; if it is
+the symbol `delete', remove those %-specs from the result;
+otherwise do the same as for the symbol `ignore', but also leave
+any occurrences of \"%%\" in FORMAT verbatim in the result."
(with-temp-buffer
(insert format)
(goto-char (point-min))
(while (search-forward "%" nil t)
(cond
- ;; Quoted percent sign.
- ((eq (char-after) ?%)
- (unless only-present
- (delete-char 1)))
- ;; Valid format spec.
- ((looking-at "\\([-0 _^<>]*\\)\\([0-9.]*\\)\\([a-zA-Z]\\)")
- (let* ((modifiers (match-string 1))
- (num (match-string 2))
- (spec (string-to-char (match-string 3)))
- (val (assq spec specification)))
- (if (not val)
- (unless only-present
- (error "Invalid format character: `%%%c'" spec))
- (setq val (cdr val)
- modifiers (format-spec--parse-modifiers modifiers))
- ;; Pad result to desired length.
- (let ((text (format "%s" val)))
- (when num
- (setq num (string-to-number num))
- (setq text (format-spec--pad text num modifiers))
- (when (> (length text) num)
- (cond
- ((memq :chop-left modifiers)
- (setq text (substring text (- (length text) num))))
- ((memq :chop-right modifiers)
- (setq text (substring text 0 num))))))
- (when (memq :uppercase modifiers)
- (setq text (upcase text)))
- (when (memq :lowercase modifiers)
- (setq text (downcase text)))
- ;; Insert first, to preserve text properties.
- (insert-and-inherit text)
- ;; Delete the specifier body.
- (delete-region (+ (match-beginning 0) (length text))
- (+ (match-end 0) (length text)))
- ;; Delete the percent sign.
- (delete-region (1- (match-beginning 0)) (match-beginning 0))))))
- ;; Signal an error on bogus format strings.
- (t
- (unless only-present
- (error "Invalid format string")))))
+ ;; Quoted percent sign.
+ ((= (following-char) ?%)
+ (when (memq ignore-missing '(nil ignore delete))
+ (delete-char 1)))
+ ;; Valid format spec.
+ ((looking-at (rx (? (group (+ (in " 0<>^_-"))))
+ (? (group (+ digit)))
+ (? (group ?. (+ digit)))
+ (group alpha)))
+ (let* ((beg (point))
+ (end (match-end 0))
+ (flags (match-string 1))
+ (width (match-string 2))
+ (trunc (match-string 3))
+ (char (string-to-char (match-string 4)))
+ (text (assq char specification)))
+ (cond (text
+ ;; Handle flags.
+ (setq text (format-spec--do-flags
+ (format "%s" (cdr text))
+ (format-spec--parse-flags flags)
+ (and width (string-to-number width))
+ (and trunc (car (read-from-string trunc 1)))))
+ ;; Insert first, to preserve text properties.
+ (insert-and-inherit text)
+ ;; Delete the specifier body.
+ (delete-region (point) (+ end (length text)))
+ ;; Delete the percent sign.
+ (delete-region (1- beg) beg))
+ ((eq ignore-missing 'delete)
+ ;; Delete the whole format spec.
+ (delete-region (1- beg) end))
+ ((not ignore-missing)
+ (error "Invalid format character: `%%%c'" char)))))
+ ;; Signal an error on bogus format strings.
+ ((not ignore-missing)
+ (error "Invalid format string"))))
(buffer-string)))
-(defun format-spec--pad (text total-length modifiers)
- (if (> (length text) total-length)
- ;; The text is longer than the specified length; do nothing.
- text
- (let ((padding (make-string (- total-length (length text))
- (if (memq :zero-pad modifiers)
- ?0
- ?\s))))
- (if (memq :right-pad modifiers)
- (concat text padding)
- (concat padding text)))))
-
-(defun format-spec--parse-modifiers (modifiers)
+(defun format-spec--do-flags (str flags width trunc)
+ "Return STR formatted according to FLAGS, WIDTH, and TRUNC.
+FLAGS is a list of keywords as returned by
+`format-spec--parse-flags'. WIDTH and TRUNC are either nil or
+string widths corresponding to `format-spec' modifiers."
+ (let (diff str-width)
+ ;; Truncate original string first, like `format' does.
+ (when trunc
+ (setq str-width (string-width str))
+ (when (> (setq diff (- str-width trunc)) 0)
+ (setq str (if (memq :chop-left flags)
+ (truncate-string-to-width str str-width diff)
+ (format (format "%%.%ds" trunc) str))
+ ;; We know the new width so save it for later.
+ str-width trunc)))
+ ;; Pad or chop to width.
+ (when width
+ (setq str-width (or str-width (string-width str))
+ diff (- width str-width))
+ (cond ((zerop diff))
+ ((> diff 0)
+ (let ((pad (make-string diff (if (memq :pad-zero flags) ?0 ?\s))))
+ (setq str (if (memq :pad-right flags)
+ (concat str pad)
+ (concat pad str)))))
+ ((memq :chop-left flags)
+ (setq str (truncate-string-to-width str str-width (- diff))))
+ ((memq :chop-right flags)
+ (setq str (format (format "%%.%ds" width) str))))))
+ ;; Fiddle case.
+ (cond ((memq :upcase flags)
+ (upcase str))
+ ((memq :downcase flags)
+ (downcase str))
+ (str)))
+
+(defun format-spec--parse-flags (flags)
+ "Convert sequence of FLAGS to list of human-readable keywords."
(mapcan (lambda (char)
- (when-let ((modifier
- (pcase char
- (?0 :zero-pad)
- (?\s :space-pad)
- (?^ :uppercase)
- (?_ :lowercase)
- (?- :right-pad)
- (?< :chop-left)
- (?> :chop-right))))
- (list modifier)))
- modifiers))
+ (pcase char
+ (?0 (list :pad-zero))
+ (?- (list :pad-right))
+ (?< (list :chop-left))
+ (?> (list :chop-right))
+ (?^ (list :upcase))
+ (?_ (list :downcase))))
+ flags))
(defun format-spec-make (&rest pairs)
"Return an alist suitable for use in `format-spec' based on PAIRS.
-PAIRS is a list where every other element is a character and a value,
-starting with a character."
+PAIRS is a property list with characters as keys."
(let (alist)
(while pairs
(unless (cdr pairs)
diff --git a/lisp/format.el b/lisp/format.el
index f3559ba9b21..905ca2d9ec9 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -342,8 +342,8 @@ for identifying regular expressions at the beginning of the region."
FORMAT defaults to `buffer-file-format'. It is a symbol naming one of the
formats defined in `format-alist', or a list of such symbols."
(interactive
- (list (format-read (format "Translate buffer to format (default %s): "
- buffer-file-format))))
+ (list (format-read (format-prompt "Translate buffer to format"
+ buffer-file-format))))
(format-encode-region (point-min) (point-max) format))
(defun format-encode-region (beg end &optional format)
@@ -352,8 +352,8 @@ FORMAT defaults to `buffer-file-format'. It is a symbol naming
one of the formats defined in `format-alist', or a list of such symbols."
(interactive
(list (region-beginning) (region-end)
- (format-read (format "Translate region to format (default %s): "
- buffer-file-format))))
+ (format-read (format-prompt "Translate region to format"
+ buffer-file-format))))
(if (null format) (setq format buffer-file-format))
(if (symbolp format) (setq format (list format)))
(save-excursion
diff --git a/lisp/forms.el b/lisp/forms.el
index 3f9f1c9980f..8974f99ef57 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -168,10 +168,9 @@
;; modified (using text-property `read-only').
;; Also, the read-write fields are shown using a
;; distinct face, if possible.
-;; As of emacs 19.29, the `intangible' text property
-;; is used to prevent moving into read-only fields.
-;; This variable defaults to t if running Emacs 19 or
-;; later with text properties.
+;; The `intangible' text property is used to
+;; prevent moving into read-only fields.
+;; This variable defaults to t.
;; The default face to show read-write fields is
;; copied from face `region'.
;;
@@ -363,8 +362,7 @@ This variable is for use by the filter routines only.
The contents may NOT be modified.")
(defcustom forms-use-text-properties t
- "Non-nil means: use text properties.
-Defaults to t if this Emacs is capable of handling text properties."
+ "Non-nil means to use text properties. "
:group 'forms
:type 'boolean)
@@ -504,12 +502,9 @@ Commands: Equivalent keys in read-only mode:
(setq forms-new-record-filter nil)
(setq forms-modified-record-filter nil)
- ;; If running Emacs 19 under X, setup faces to show read-only and
- ;; read-write fields.
- (if (fboundp 'make-face)
- (progn
- (make-local-variable 'forms-ro-face)
- (make-local-variable 'forms-rw-face)))
+ ;; Setup faces to show read-only and read-write fields.
+ (make-local-variable 'forms-ro-face)
+ (make-local-variable 'forms-rw-face)
;; eval the buffer, should set variables
;;(message "forms: processing control file...")
@@ -609,16 +604,14 @@ Commands: Equivalent keys in read-only mode:
(setq forms--mode-setup t)
;; Copy desired faces to the actual variables used by the forms formatter.
- (if (fboundp 'make-face)
+ (make-local-variable 'forms--ro-face)
+ (make-local-variable 'forms--rw-face)
+ (if forms-read-only
(progn
- (make-local-variable 'forms--ro-face)
- (make-local-variable 'forms--rw-face)
- (if forms-read-only
- (progn
- (setq forms--ro-face forms-ro-face)
- (setq forms--rw-face forms-ro-face))
- (setq forms--ro-face forms-ro-face)
- (setq forms--rw-face forms-rw-face))))
+ (setq forms--ro-face forms-ro-face)
+ (setq forms--rw-face forms-ro-face))
+ (setq forms--ro-face forms-ro-face)
+ (setq forms--rw-face forms-rw-face))
;; Make more local variables.
(make-local-variable 'forms--file-buffer)
diff --git a/lisp/frame.el b/lisp/frame.el
index 16ee7580f89..772ba3d8c47 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -713,6 +713,18 @@ The optional argument PARAMETERS specifies additional frame parameters."
(x-display-list))))
(make-frame (cons (cons 'display display) parameters)))
+(defun make-frame-on-current-monitor (&optional parameters)
+ "Make a frame on the currently selected monitor.
+Like `make-frame-on-monitor' and with the same PARAMETERS as in `make-frame'."
+ (interactive)
+ (let* ((monitor-workarea
+ (cdr (assq 'workarea (frame-monitor-attributes))))
+ (geometry-parameters
+ (when monitor-workarea
+ `((top . ,(nth 1 monitor-workarea))
+ (left . ,(nth 0 monitor-workarea))))))
+ (make-frame (append geometry-parameters parameters))))
+
(defun make-frame-on-monitor (monitor &optional display parameters)
"Make a frame on monitor MONITOR.
The optional argument DISPLAY can be a display name, and the optional
@@ -721,7 +733,7 @@ argument PARAMETERS specifies additional frame parameters."
(list
(let* ((default (cdr (assq 'name (frame-monitor-attributes)))))
(completing-read
- (format "Make frame on monitor (default %s): " default)
+ (format-prompt "Make frame on monitor" default)
(or (delq nil (mapcar (lambda (a)
(cdr (assq 'name a)))
(display-monitor-attributes-list)))
@@ -748,7 +760,7 @@ If DISPLAY is nil, that stands for the selected frame's display."
(list
(let* ((default (frame-parameter nil 'display))
(display (completing-read
- (format "Close display (default %s): " default)
+ (format-prompt "Close display" default)
(delete-dups
(mapcar (lambda (frame)
(frame-parameter frame 'display))
@@ -1058,6 +1070,23 @@ that variable should be nil."
(setq arg (1+ arg)))
(select-frame-set-input-focus frame)))
+(defun other-frame-prefix ()
+ "Display the buffer of the next command in a new frame.
+The next buffer is the buffer displayed by the next command invoked
+immediately after this command (ignoring reading from the minibuffer).
+Creates a new frame before displaying the buffer.
+When `switch-to-buffer-obey-display-actions' is non-nil,
+`switch-to-buffer' commands are also supported."
+ (interactive)
+ (display-buffer-override-next-command
+ (lambda (buffer alist)
+ (cons (display-buffer-pop-up-frame
+ buffer (append '((inhibit-same-window . t))
+ alist))
+ 'frame))
+ nil "[other-frame]")
+ (message "Display next command buffer in a new frame..."))
+
(defun iconify-or-deiconify-frame ()
"Iconify the selected frame, or deiconify if it's currently an icon."
(interactive)
@@ -1101,7 +1130,7 @@ If there is no frame by that name, signal an error."
(let* ((frame-names-alist (make-frame-names-alist))
(default (car (car frame-names-alist)))
(input (completing-read
- (format "Select Frame (default %s): " default)
+ (format-prompt "Select Frame" default)
frame-names-alist nil t nil 'frame-name-history)))
(if (= (length input) 0)
(list default)
@@ -1215,13 +1244,10 @@ face specs for the new background mode."
;; during startup with -rv on the command
;; line for the initial frame, because frames
;; are not recorded in the pdump file.
- (assq face (frame-face-alist))
+ (assq face (frame-face-alist frame))
(face-spec-match-p face
(face-user-default-spec face)
- ;; FIXME: why selected-frame and
- ;; not the frame that is the
- ;; argument to this function?
- (selected-frame))))
+ frame)))
(push face locally-modified-faces)))
;; Now change to the new frame parameters
(modify-frame-parameters frame params)
@@ -1383,12 +1409,12 @@ as though the font-related attributes of the `default' face had been
\"set in this session\", so that the font is applied to future frames."
(interactive
(let* ((completion-ignore-case t)
- (font (completing-read "Font name: "
+ (default (frame-parameter nil 'font))
+ (font (completing-read (format-prompt "Font name" default)
;; x-list-fonts will fail with an error
;; if this frame doesn't support fonts.
(x-list-fonts "*" nil (selected-frame))
- nil nil nil nil
- (frame-parameter nil 'font))))
+ nil nil nil nil default)))
(list font current-prefix-arg nil)))
(when (or (stringp font) (fontp font))
(let* ((this-frame (selected-frame))
@@ -1552,8 +1578,9 @@ When called interactively, prompt for the name of the frame.
On text terminals, the frame name is displayed on the mode line.
On graphical displays, it is displayed on the frame's title bar."
(interactive
- (list (read-string "Frame name: " nil nil
- (cdr (assq 'name (frame-parameters))))))
+ (let ((default (cdr (assq 'name (frame-parameters)))))
+ (list (read-string (format-prompt "Frame name" default) nil nil
+ default))))
(modify-frame-parameters (selected-frame)
(list (cons 'name name))))
@@ -1907,7 +1934,7 @@ for FRAME."
;; features change, it will be easy to find all the tests for such
;; capabilities by a simple text search. See more about the history
;; and the intent of these functions in
-;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/msg00004.html
+;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/msg00004.html
;; or in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35058#17.
(declare-function msdos-mouse-p "dosfns.c")
@@ -2676,11 +2703,7 @@ See also `toggle-frame-maximized'."
(set-frame-parameter frame 'fullscreen fullscreen-restore)
(set-frame-parameter frame 'fullscreen nil)))
(modify-frame-parameters
- frame `((fullscreen . fullboth) (fullscreen-restore . ,fullscreen))))
- ;; Manipulating a frame without waiting for the fullscreen
- ;; animation to complete can cause a crash, or other unexpected
- ;; behavior, on macOS (bug#28496).
- (when (featurep 'cocoa) (sleep-for 0.5))))
+ frame `((fullscreen . fullboth) (fullscreen-restore . ,fullscreen))))))
;;;; Key bindings
@@ -2689,6 +2712,7 @@ See also `toggle-frame-maximized'."
(define-key ctl-x-5-map "1" 'delete-other-frames)
(define-key ctl-x-5-map "0" 'delete-frame)
(define-key ctl-x-5-map "o" 'other-frame)
+(define-key ctl-x-5-map "5" 'other-frame-prefix)
(define-key global-map [f11] 'toggle-frame-fullscreen)
(define-key global-map [(meta f10)] 'toggle-frame-maximized)
(define-key esc-map [f10] 'toggle-frame-maximized)
diff --git a/lisp/frameset.el b/lisp/frameset.el
index 10c6914f52d..0462d776c0e 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -396,17 +396,17 @@ Properties can be set with
;; or, if you're only changing a few items,
;;
;; (defvar my-filter-alist
-;; (nconc '((my-param1 . :never)
-;; (my-param2 . my-filtering-function))
-;; frameset-filter-alist)
+;; (append '((my-param1 . :never)
+;; (my-param2 . my-filtering-function))
+;; frameset-filter-alist)
;; "My brief customized parameter filter alist.")
;;
;; and pass it to the FILTER arg of the save/restore functions,
;; ALWAYS taking care of not modifying the original lists; if you're
;; going to do any modifying of my-filter-alist, please use
;;
-;; (nconc '((my-param1 . :never) ...)
-;; (copy-sequence frameset-filter-alist))
+;; (append '((my-param1 . :never) ...)
+;; (copy-sequence frameset-filter-alist))
;;
;; One thing you shouldn't forget is that they are alists, so searching
;; in them is sequential. If you just want to change the default of
@@ -445,7 +445,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
;;;###autoload
(defvar frameset-persistent-filter-alist
- (nconc
+ (append
'((background-color . frameset-filter-sanitize-color)
(buffer-list . :never)
(buffer-predicate . :never)
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index cd24f497c96..48ac1232051 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -643,7 +643,7 @@ like an INI file. You can add this hook to `find-file-hook'."
("\\([^ =\n\r]+\\)=\\([^ \n\r]*\\)"
(1 font-lock-variable-name-face)
(2 font-lock-keyword-face)))
- '("inventory")
+ '("inventory\\'")
(list
(function
(lambda ()
diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2
index 2f5dd22930e..533ceb84bf1 100644
--- a/lisp/gnus/ChangeLog.2
+++ b/lisp/gnus/ChangeLog.2
@@ -3378,7 +3378,7 @@
* gnus-async.el (gnus-asynchronous): Move defcustom of
gnus-asynchronous away from defgroup of gnus-asynchronous.
- This seems to fix an intermittant error in which loading gnus-async
+ This seems to fix an intermittent error in which loading gnus-async
fails to define gnus-asynchronous (the variable).
* gnus-sum.el: Concur with Steve Young, 5th argument to 'load' is
@@ -7096,7 +7096,7 @@
* nnimap.el (nnimap-callback-callback-function):
(nnimap-callback-buffer): Remove, these cannot be global but must
be embedded into the callback.
- (nnimap-make-callback): New. Embedd article number, callback and
+ (nnimap-make-callback): New. Embed article number, callback and
buffer in function.
(nnimap-callback, nnimap-request-article-part): Update.
@@ -8031,7 +8031,7 @@
(message-xpost-fup2-header, message-xpost-insert-note)
(message-xpost-fup2, message-reduce-to-to-cc): New functions
adopted from message-utils.el. Add functions to the keymap, mode
- describtion and menu.
+ description and menu.
(message-change-subject, message-xpost-fup2): Signal error if
current header is empty.
(message-xpost-insert-note): Change insert position.
@@ -8612,7 +8612,7 @@
2002-06-11 Simon Josefsson <jas@extundo.com>
* gnus-int.el (gnus-request-move-article): Agent expire article if
- successfuly moved.
+ successfully moved.
2002-06-11 Niklas Morberg <niklas.morberg@axis.com>
@@ -9073,7 +9073,7 @@
2002-04-13 Josh Huber <huber@alum.wpi.edu>
- * mml-sec.el (mml-secure-message): Change to support arbritrary
+ * mml-sec.el (mml-secure-message): Change to support arbitrary
modes.
* mml-sec.el (mml-secure-message-encrypt-(smime|pgp|pgpmime)):
changed to support "signencrypt" mode.
diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3
index 70eaeb510ac..582c9bd10b7 100644
--- a/lisp/gnus/ChangeLog.3
+++ b/lisp/gnus/ChangeLog.3
@@ -170,7 +170,7 @@
2015-02-09 Lars Ingebrigtsen <larsi@gnus.org>
* mm-decode.el (mm-convert-shr-links): Don't overwrite the faces from
- shr, beacause that breaks folding.
+ shr, because that breaks folding.
(mm-shr): Don't shorten the width when using fonts.
2015-02-05 Teodor Zlatanov <tzz@lifelogs.com>
@@ -596,7 +596,7 @@
2014-06-05 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-art.el (gnus-article-edit-part): Don't modifiy markers.
+ * gnus-art.el (gnus-article-edit-part): Don't modify markers.
(gnus-article-read-summary-keys):
Don't bug out when there is no article in the summary buffer.
(gnus-mime-buttonize-attachments-in-header):
@@ -1318,7 +1318,7 @@
2013-08-06 Jan Tatarik <jan.tatarik@gmail.com>
* gnus-icalendar.el (gnus-icalendar-event-from-ical): Replace pcase
- with cond for backwards compatability.
+ with cond for backwards compatibility.
2013-08-06 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -2221,7 +2221,7 @@
2013-04-04 Katsumi Yamaoka <yamaoka@jpl.org>
- * mml.el (mml-minibuffer-read-description): Use `default' insted of
+ * mml.el (mml-minibuffer-read-description): Use `default' instead of
`initial-input' for the argument name.
Suggested by Stefan Monnier <monnier@iro.umontreal.ca>.
@@ -5541,7 +5541,7 @@
(registry-prune-hard): Use it.
* gnus-registry.el (gnus-registry-fixup-registry): Set prune-factor to
- 0.1 expicitly.
+ 0.1 explicitly.
2011-05-13 Glenn Morris <rgm@gnu.org>
@@ -8758,7 +8758,7 @@
* shr.el (shr-generic): The text nodes should be text, not :text.
- * nnir.el (nnir-search-engine): Ressurect variable, since it's used
+ * nnir.el (nnir-search-engine): Resurrect variable, since it's used
later in the file.
2010-10-30 Andrew Cohen <cohen@andy.bu.edu>
@@ -9481,7 +9481,7 @@
nil.
* gnus-start.el (gnus-get-unread-articles): Require gnus-agent before
- bidning gnus-agent variables.
+ binding gnus-agent variables.
* shr.el (shr-render-td): Use a cache for the table rendering function
to avoid getting an exponential rendering behavior in nested tables.
@@ -11849,7 +11849,7 @@
2010-08-13 Teodor Zlatanov <tzz@lifelogs.com>
- Doc fixes and keep unknown groups (ammended for nunion bug fix).
+ Doc fixes and keep unknown groups (amended for nunion bug fix).
* gnus-sync.el: Fix docs.
(gnus-sync-save): Keep unknown groups in `gnus-sync-newsrc-loader'.
@@ -18925,7 +18925,7 @@
* message.el: Autoload gmm-image-load-path.
(message-tool-bar-retro): Prepend "gnus/" subdirectory to some
icon file names. Use old Emacs 21 "mail_send.xpm" icon for
- consitency.
+ consistency.
* gmm-utils.el (gmm-image-load-path): Also search in
"../etc/images". Don't set gmm-image-load-path if we don't find
@@ -19523,7 +19523,7 @@
* nnml.el: Don't require gnus-bcklg. Autoload it.
(nnml-use-compressed-files, nnml-save-mail): Support other
- comression programs such as bzip2.
+ compression programs such as bzip2.
2005-12-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -21227,7 +21227,7 @@
(nntp-with-open-group): Allow debugging.
* nnheader.el (mail-header-set-extra): Make into a function
- because I just could't understand how to quote the list properly.
+ because I just couldn't understand how to quote the list properly.
* dns.el (query-dns-cached): New function.
@@ -24966,7 +24966,7 @@
functions as needing (default), or not needing,
gnus-convert-old-newsrc's "backup before upgrading warning".
(gnus-convert-converter-needs-prompt): Tests whether the user
- should be protected from potentially irreversable changes by the
+ should be protected from potentially irreversible changes by the
function.
* legacy-gnus-agent.el: New. Provides converters that are only
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index 82dbbab5e0d..647f643c962 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -266,21 +266,21 @@
"\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, "
"Regular expression matching the beginning of an attribution line that should be cut off."
:version "22.1"
- :type 'string
+ :type 'regexp
:group 'gnus-outlook-deuglify)
(defcustom gnus-outlook-deuglify-attrib-verb-regexp
"wrote\\|writes\\|says\\|schrieb\\|schreibt\\|meinte\\|skrev\\|a écrit\\|schreef\\|escribió"
"Regular expression matching the verb used in an attribution line."
:version "22.1"
- :type 'string
+ :type 'regexp
:group 'gnus-outlook-deuglify)
(defcustom gnus-outlook-deuglify-attrib-end-regexp
": *\\|\\.\\.\\."
"Regular expression matching the end of an attribution line."
:version "22.1"
- :type 'string
+ :type 'regexp
:group 'gnus-outlook-deuglify)
(defcustom gnus-outlook-display-hook nil
@@ -403,9 +403,9 @@ NODISPLAY is non-nil, don't redisplay the article buffer."
(gnus-with-article-buffer
(article-goto-body)
(when (re-search-forward
- (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n"
+ (concat "^[" cite-marks " \t]*--*[^-]+ [^-]+--*\\s *\n"
"[^\n:]+:[ \t]*\\([^\n]+\\)\n"
- "\\([^\n:]+:[ \t]*[^\n]+\n\\)+")
+ "\\([^\n:]+:[^\n]+\n\\)+")
nil t)
(gnus-kill-all-overlays)
(replace-match "\\1 wrote:\n")
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index 2df098bc0bf..6d24b409ed0 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -168,9 +168,9 @@ ARGS are passed to `message'."
(defcustom gmm-tool-bar-style
(if (and (boundp 'tool-bar-mode)
tool-bar-mode
- (memq (display-visual-class)
- (list 'static-gray 'gray-scale
- 'static-color 'pseudo-color)))
+ (not (memq (display-visual-class)
+ (list 'static-gray 'gray-scale
+ 'static-color 'pseudo-color))))
'gnome
'retro)
"Preferred tool bar style."
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index cf705ae5dc1..76c2904eaf0 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -603,11 +603,22 @@ manipulated as follows:
(gnus))
;;;###autoload
+(defun gnus-child-unplugged (&optional arg)
+ "Read news as a child unplugged."
+ (interactive "P")
+ (setq gnus-plugged nil)
+ (gnus arg nil 'child))
+
+;;;###autoload
(defun gnus-slave-unplugged (&optional arg)
- "Read news as a slave unplugged."
+ "Read news as a child unplugged."
(interactive "P")
(setq gnus-plugged nil)
- (gnus arg nil 'slave))
+ (gnus arg nil 'child))
+(make-obsolete 'gnus-slave-unplugged 'gnus-child-unplugged "28.1")
+
+
+
;;;###autoload
(defun gnus-agentize ()
@@ -799,7 +810,7 @@ be a select method."
(let ((gnus-command-method method)
(gnus-agent nil))
(when (file-exists-p (gnus-agent-lib-file "flags"))
- (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
+ (set-buffer (gnus-get-buffer-create " *Gnus Agent flag synchronize*"))
(erase-buffer)
(nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
(cond ((null gnus-plugged)
@@ -1293,7 +1304,7 @@ downloaded into the agent."
;; gnus doesn't waste resources trying to fetch them.
;; NOTE: I don't do this for smaller gaps (< 100) as I don't
- ;; want to modify the local file everytime someone restarts
+ ;; want to modify the local file every time someone restarts
;; gnus. The small gap will cause a tiny performance hit
;; when gnus tries, and fails, to retrieve the articles.
;; Still that should be smaller than opening a buffer,
@@ -3923,7 +3934,7 @@ If REREAD is not nil, downloaded articles are marked as unread."
(mm-with-unibyte-buffer
(nnheader-insert-file-contents file)
(nnheader-remove-body)
- (setq header (nnheader-parse-naked-head)))
+ (setq header (nnheader-parse-head t)))
(setf (mail-header-number header) (car downloaded))
(if nov-arts
(let ((key (concat "^" (int-to-string (car nov-arts))
@@ -4022,11 +4033,11 @@ If REREAD is not nil, downloaded articles are marked as unread."
(list (list
(if (listp reread)
reread
- (delq nil (mapcar (function (lambda (c)
- (cond ((eq reread t)
- (car c))
- ((cdr c)
- (car c)))))
+ (delq nil (mapcar (lambda (c)
+ (cond ((eq reread t)
+ (car c))
+ ((cdr c)
+ (car c))))
gnus-agent-article-alist)))
'del '(read)))
gnus-command-method)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 6b9610d3121..1efc1d6f7d9 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -274,6 +274,7 @@ This can also be a list of the above values."
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
:type '(choice string
+ (const :tag "None" nil)
(function-item gnus-display-x-face-in-from)
function)
:version "27.1"
@@ -534,6 +535,13 @@ that the symbol of the saver function, which is specified by
:group 'gnus-article-saving
:type 'regexp)
+(defcustom gnus-global-groups nil
+ "Groups that should be considered like \"news\" groups.
+This means that images will be automatically loaded, for instance."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-article)
+
;; Note that "Rmail format" is mbox since Emacs 23, but Babyl before.
(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
"A function to save articles in your favorite format.
@@ -2161,7 +2169,9 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
(interactive)
(save-excursion
(when (article-goto-body)
- (let ((inhibit-read-only t))
+ (require 'ansi-color)
+ (let ((inhibit-read-only t)
+ (ansi-color-context-region nil))
(ansi-color-apply-on-region (point) (point-max))))))
(defun gnus-article-treat-unfold-headers ()
@@ -2303,21 +2313,27 @@ long lines if and only if arg is positive."
"\n")
(put-text-property start (point) 'gnus-decoration 'header)))))
-(defun article-fill-long-lines ()
- "Fill lines that are wider than the window width."
- (interactive)
+(defun article-fill-long-lines (&optional width)
+ "Fill lines that are wider than the window width or `fill-column'.
+If WIDTH (interactively, the numeric prefix), use that as the
+fill width."
+ (interactive "P")
(save-excursion
- (let ((inhibit-read-only t)
- (width (window-width (get-buffer-window (current-buffer)))))
+ (let* ((inhibit-read-only t)
+ (window-width (window-width (get-buffer-window (current-buffer))))
+ (width (if width
+ (prefix-numeric-value width)
+ (min fill-column window-width))))
(save-restriction
(article-goto-body)
(let ((adaptive-fill-mode nil)) ;Why? -sm
(while (not (eobp))
(end-of-line)
- (when (>= (current-column) (min fill-column width))
+ (when (>= (current-column) width)
(narrow-to-region (min (1+ (point)) (point-max))
(point-at-bol))
- (let ((goback (point-marker)))
+ (let ((goback (point-marker))
+ (fill-column width))
(fill-paragraph nil)
(goto-char (marker-position goback)))
(widen))
@@ -4406,6 +4422,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
"e" gnus-article-read-summary-keys
"\C-d" gnus-article-read-summary-keys
+ "\C-c\C-f" gnus-summary-mail-forward
"\M-*" gnus-article-read-summary-keys
"\M-#" gnus-article-read-summary-keys
"\M-^" gnus-article-read-summary-keys
@@ -5833,6 +5850,7 @@ all parts."
"" "..."))
(gnus-tmp-length (with-current-buffer (mm-handle-buffer handle)
(buffer-size)))
+ (help-echo "mouse-2: toggle the MIME part; down-mouse-3: more options")
gnus-tmp-type-long b e)
(when (string-match ".*/" gnus-tmp-name)
(setq gnus-tmp-name (replace-match "" t t gnus-tmp-name)))
@@ -5841,6 +5859,19 @@ all parts."
(concat "; " gnus-tmp-name))))
(unless (equal gnus-tmp-description "")
(setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
+ (when (and (zerop gnus-tmp-length)
+ ;; Only nnimap supports partial fetches so far.
+ nnimap-fetch-partial-articles
+ (string-match "^nnimap\\+" gnus-newsgroup-name))
+ (setq gnus-tmp-type-long
+ (concat
+ gnus-tmp-type-long
+ (substitute-command-keys
+ (concat "\\<gnus-summary-mode-map> (not downloaded, "
+ "\\[gnus-summary-show-complete-article] to fetch.)"))))
+ (setq help-echo
+ (concat "Type \\[gnus-summary-show-complete-article] "
+ "to download complete article. " help-echo)))
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
@@ -5859,8 +5890,7 @@ all parts."
'keymap gnus-mime-button-map
'face gnus-article-button-face
'follow-link t
- 'help-echo
- "mouse-2: toggle the MIME part; down-mouse-3: more options")))
+ 'help-echo help-echo)))
(defvar gnus-displaying-mime nil)
@@ -6001,6 +6031,7 @@ If nil, don't show those extra buttons."
(defun gnus-mime-display-single (handle)
(let ((type (mm-handle-media-type handle))
(ignored gnus-ignored-mime-types)
+ (mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight))
(not-attachment t)
display text)
(catch 'ignored
@@ -6664,7 +6695,7 @@ not have a face in `gnus-article-boring-faces'."
(interactive "P")
(gnus-article-check-buffer)
(let ((nosaves
- '("q" "Q" "r" "\C-c\C-f" "m" "a" "f" "WDD" "WDW"
+ '("q" "Q" "r" "m" "a" "f" "WDD" "WDW"
"Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
"=" "^" "\M-^" "|"))
(nosave-but-article
@@ -7065,6 +7096,7 @@ If given a prefix, show the hidden text instead."
(gnus-backlog-enter-article
group article (current-buffer)))
(when (and gnus-agent
+ gnus-agent-eagerly-store-articles
(gnus-agent-group-covered-p group))
(gnus-agent-store-article article group)))
(setq result 'article))
@@ -7120,7 +7152,8 @@ If given a prefix, show the hidden text instead."
"Allows images in newsgroups to be shown, blocks images in all
other groups."
(if (or (gnus-news-group-p group)
- (gnus-member-of-valid 'global group))
+ (gnus-member-of-valid 'global group)
+ (member group gnus-global-groups))
;; Block nothing in news groups.
nil
;; Block everything anywhere else.
@@ -7708,6 +7741,15 @@ positives are possible."
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1)
("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1)
+ ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
+ ("<URL: *\\([^\n<>]*\\)>"
+ 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
+ ;; RFC 2396 (2.4.3., delims) ...
+ ("\"URL: *\\([^\n\"]*\\)\""
+ 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
+ ;; Raw URLs.
+ (gnus-button-url-regexp
+ 0 (>= gnus-button-browse-level 0) browse-url-button-open-url 0)
;; The following entries may lead to many false positives so don't enable
;; them by default (use a high button level).
("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]"
@@ -7731,15 +7773,6 @@ positives are possible."
;; Unlike the other regexps we really have to require quoting
;; here to determine where it ends.
1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
- ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
- ("<URL: *\\([^\n<>]*\\)>"
- 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
- ;; RFC 2396 (2.4.3., delims) ...
- ("\"URL: *\\([^\n\"]*\\)\""
- 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
- ;; Raw URLs.
- (gnus-button-url-regexp
- 0 (>= gnus-button-browse-level 0) browse-url-button-open-url 0)
;; man pages
("\\b\\([a-z][a-z]+([1-9])\\)\\W"
0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
@@ -8323,6 +8356,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(and (match-end 6) (list (string-to-number (match-string 6 address))))))))
(defun gnus-url-parse-query-string (query &optional downcase)
+ (declare (obsolete message-parse-mailto-url "28.1"))
(let (retval pairs cur key val)
(setq pairs (split-string query "&"))
(while pairs
@@ -8342,31 +8376,8 @@ url is put as the `gnus-button-url' overlay property on the button."
(defun gnus-url-mailto (url)
;; Send mail to someone
- (setq url (replace-regexp-in-string "\n" " " url))
- (when (string-match "mailto:/*\\(.*\\)" url)
- (setq url (substring url (match-beginning 1) nil)))
- (let* ((args (gnus-url-parse-query-string
- (if (string-match "^\\?" url)
- (substring url 1)
- (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
- (concat "to=" (match-string 1 url) "&"
- (match-string 2 url))
- (concat "to=" url)))))
- (subject (cdr-safe (assoc "subject" args)))
- func)
- (gnus-msg-mail)
- (while args
- (setq func (intern-soft (concat "message-goto-" (downcase (caar args)))))
- (if (fboundp func)
- (funcall func)
- (message-position-on-field (caar args)))
- (insert (replace-regexp-in-string
- "\r\n" "\n"
- (mapconcat #'identity (reverse (cdar args)) ", ") nil t))
- (setq args (cdr args)))
- (if subject
- (message-goto-body)
- (message-goto-subject))))
+ (gnus-msg-mail)
+ (message-mailto-1 url))
(defun gnus-button-embedded-url (address)
"Activate ADDRESS with `browse-url'."
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index e3e81c8bbce..9b08e6a0ef8 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -227,6 +227,7 @@ that was fetched."
(narrow-to-region mark (point-max))
;; Put the articles into the agent, if they aren't already.
(when (and gnus-agent
+ gnus-agent-eagerly-store-articles
(gnus-agent-group-covered-p group))
(save-restriction
(narrow-to-region mark (point-max))
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index ea4af2df0c4..4f85349d166 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -242,7 +242,7 @@ So the cdr of each bookmark is an alist too.")
(save-window-excursion
;; Avoid warnings?
;; (message "Saving Gnus bookmarks to file %s..." gnus-bookmark-default-file)
- (set-buffer (get-buffer-create " *Gnus bookmarks*"))
+ (set-buffer (gnus-get-buffer-create " *Gnus bookmarks*"))
(erase-buffer)
(gnus-bookmark-insert-file-format-version-stamp)
(pp gnus-bookmark-alist (current-buffer))
@@ -345,8 +345,7 @@ copy of the alist."
(when gnus-bookmark-sort-flag
(setq gnus-bookmark-alist
(sort (copy-alist gnus-bookmark-alist)
- (function
- (lambda (x y) (string-lessp (car x) (car y))))))))
+ (lambda (x y) (string-lessp (car x) (car y)))))))
;;;###autoload
(defun gnus-bookmark-bmenu-list ()
@@ -357,8 +356,8 @@ deletion, or > if it is flagged for displaying."
(interactive)
(gnus-bookmark-maybe-load-default-file)
(if (called-interactively-p 'any)
- (switch-to-buffer (get-buffer-create "*Gnus Bookmark List*"))
- (set-buffer (get-buffer-create "*Gnus Bookmark List*")))
+ (switch-to-buffer (gnus-get-buffer-create "*Gnus Bookmark List*"))
+ (set-buffer (gnus-get-buffer-create "*Gnus Bookmark List*")))
(let ((inhibit-read-only t)
alist name start end)
(erase-buffer)
@@ -648,7 +647,7 @@ reposition and try again, else return nil."
(details gnus-bookmark-bookmark-details)
detail)
(save-excursion
- (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t)
+ (pop-to-buffer (gnus-get-buffer-create "*Gnus Bookmark Annotation*") t)
(erase-buffer)
(while details
(setq detail (pop details))
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 02a8ea723d3..c31d97d41cd 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -93,6 +93,8 @@ it's not cached."
(autoload 'nnml-generate-nov-databases-directory "nnml")
(autoload 'nnvirtual-find-group-art "nnvirtual")
+(autoload 'nnselect-article-group "nnselect")
+(autoload 'nnselect-article-number "nnselect")
@@ -158,8 +160,12 @@ it's not cached."
(file-name-coding-system nnmail-pathname-coding-system))
;; If this is a virtual group, we find the real group.
(when (gnus-virtual-group-p group)
- (let ((result (nnvirtual-find-group-art
- (gnus-group-real-name group) article)))
+ (let ((result (if (gnus-nnselect-group-p group)
+ (with-current-buffer gnus-summary-buffer
+ (cons (nnselect-article-group article)
+ (nnselect-article-number article)))
+ (nnvirtual-find-group-art
+ (gnus-group-real-name group) article))))
(setq group (car result)
number (cdr result))))
(when (and number
@@ -186,7 +192,7 @@ it's not cached."
(gnus-cache-update-file-total-fetched-for group file))
(setq lines-chars (nnheader-get-lines-and-char))
(nnheader-remove-body)
- (setq headers (nnheader-parse-naked-head))
+ (setq headers (nnheader-parse-head t))
(setf (mail-header-number headers) number)
(setf (mail-header-lines headers) (car lines-chars))
(setf (mail-header-chars headers) (cadr lines-chars))
@@ -232,8 +238,14 @@ it's not cached."
(let ((arts gnus-cache-removable-articles)
ga)
(while arts
- (when (setq ga (nnvirtual-find-group-art
- (gnus-group-real-name gnus-newsgroup-name) (pop arts)))
+ (when (setq ga
+ (if (gnus-nnselect-group-p gnus-newsgroup-name)
+ (with-current-buffer gnus-summary-buffer
+ (let ((article (pop arts)))
+ (cons (nnselect-article-group article)
+ (nnselect-article-number article))))
+ (nnvirtual-find-group-art
+ (gnus-group-real-name gnus-newsgroup-name) (pop arts))))
(let ((gnus-cache-removable-articles (list (cdr ga)))
(gnus-newsgroup-name (car ga)))
(gnus-cache-possibly-remove-articles-1)))))
@@ -467,8 +479,12 @@ Returns the list of articles removed."
(file-name-coding-system nnmail-pathname-coding-system))
;; If this is a virtual group, we find the real group.
(when (gnus-virtual-group-p group)
- (let ((result (nnvirtual-find-group-art
- (gnus-group-real-name group) article)))
+ (let ((result (if (gnus-nnselect-group-p group)
+ (with-current-buffer gnus-summary-buffer
+ (cons (nnselect-article-group article)
+ (nnselect-article-number article)))
+ (nnvirtual-find-group-art
+ (gnus-group-real-name group) article))))
(setq group (car result)
number (cdr result))))
(setq file (gnus-cache-file-name group number))
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index cecfaef2f4f..3e23e263262 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -223,13 +223,10 @@ easy interactive way to set this from the Server buffer."
(t
(gnus-message 1 "Unknown type %s; ignoring" type))))))
-(defun gnus-cloud-update-newsrc-data (group elem &optional force-older)
- "Update the newsrc data for GROUP from ELEM.
-Use old data if FORCE-OLDER is not nil."
+(defun gnus-cloud-update-newsrc-data (group elem)
+ "Update the newsrc data for GROUP from ELEM."
(let* ((contents (plist-get elem :contents))
(date (or (plist-get elem :timestamp) "0"))
- (now (gnus-cloud-timestamp nil))
- (newer (string-lessp date now))
(group-info (gnus-get-info group)))
(if (and contents
(stringp (nth 0 contents))
@@ -238,15 +235,13 @@ Use old data if FORCE-OLDER is not nil."
(if (equal (format "%S" group-info)
(format "%S" contents))
(gnus-message 3 "Skipping cloud update of group %s, the info is the same" group)
- (if (and newer (not force-older))
- (gnus-message 3 "Skipping outdated cloud info for group %s, the info is from %s (now is %s)" group date now)
- (when (or (not gnus-cloud-interactive)
- (gnus-y-or-n-p
- (format "%s has older different info in the cloud as of %s, update it here? "
- group date))))
- (gnus-message 2 "Installing cloud update of group %s" group)
- (gnus-set-info group contents)
- (gnus-group-update-group group)))
+ (when (or (not gnus-cloud-interactive)
+ (gnus-y-or-n-p
+ (format "%s has different info in the cloud from %s, update it here? "
+ group date)))
+ (gnus-message 2 "Installing cloud update of group %s" group)
+ (gnus-set-info group contents)
+ (gnus-group-update-group group)))
(gnus-error 1 "Sorry, group %s is not subscribed" group))
(gnus-error 1 "Sorry, could not update newsrc for group %s (invalid data %S)"
group elem))))
@@ -285,8 +280,8 @@ Use old data if FORCE-OLDER is not nil."
(insert new-contents)
(when (file-exists-p file-name)
(rename-file file-name (car (find-backup-file-name file-name))))
- (write-region (point-min) (point-max) file-name)
- (set-file-times file-name (parse-iso8601-time-string date))))
+ (write-region (point-min) (point-max) file-name nil nil nil 'excl)
+ (set-file-times file-name (parse-iso8601-time-string date) 'nofollow)))
(defun gnus-cloud-file-covered-p (file-name)
(let ((matched nil))
@@ -380,8 +375,9 @@ When FULL is t, upload everything, not just a difference from the last full."
(gnus-cloud-files-to-upload full)
(gnus-cloud-collect-full-newsrc)))
(group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)))
+ (setq gnus-cloud-sequence (1+ (or gnus-cloud-sequence 0)))
(insert (format "Subject: (sequence: %s type: %s storage-method: %s)\n"
- (or gnus-cloud-sequence "UNKNOWN")
+ gnus-cloud-sequence
(if full :full :partial)
gnus-cloud-storage-method))
(insert "From: nobody@gnus.cloud.invalid\n")
@@ -390,12 +386,13 @@ When FULL is t, upload everything, not just a difference from the last full."
(if (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method
t t)
(progn
- (setq gnus-cloud-sequence (1+ (or gnus-cloud-sequence 0)))
(gnus-cloud-add-timestamps elems)
(gnus-message 3 "Uploaded Gnus Cloud data successfully to %s" group)
(gnus-group-refresh-group group))
(gnus-error 2 "Failed to upload Gnus Cloud data to %s" group)))))
+(defvar gnus-alter-header-function)
+
(defun gnus-cloud-add-timestamps (elems)
(dolist (elem elems)
(let* ((file-name (plist-get elem :file-name))
@@ -414,8 +411,9 @@ When FULL is t, upload everything, not just a difference from the last full."
(when (gnus-retrieve-headers (gnus-uncompress-range active) group)
(with-current-buffer nntp-server-buffer
(goto-char (point-min))
- (while (and (not (eobp))
- (setq head (nnheader-parse-head)))
+ (while (setq head (nnheader-parse-head))
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function head))
(push head headers))))
(sort (nreverse headers)
(lambda (h1 h2)
@@ -459,18 +457,21 @@ instead of `gnus-cloud-sequence'.
When UPDATE is t, returns the result of calling `gnus-cloud-update-all'.
Otherwise, returns the Gnus Cloud data chunks."
(let ((articles nil)
+ (highest-sequence-seen gnus-cloud-sequence)
chunks)
(dolist (header (gnus-cloud-available-chunks))
- (when (> (gnus-cloud-chunk-sequence (mail-header-subject header))
- (or sequence-override gnus-cloud-sequence -1))
-
- (if (string-match (format "storage-method: %s" gnus-cloud-storage-method)
- (mail-header-subject header))
- (push (mail-header-number header) articles)
- (gnus-message 1 "Skipping article %s because it didn't match the Gnus Cloud method %s: %s"
- (mail-header-number header)
- gnus-cloud-storage-method
- (mail-header-subject header)))))
+ (let ((this-sequence (gnus-cloud-chunk-sequence (mail-header-subject header))))
+ (when (> this-sequence (or sequence-override gnus-cloud-sequence -1))
+
+ (if (string-match (format "storage-method: %s" gnus-cloud-storage-method)
+ (mail-header-subject header))
+ (progn
+ (push (mail-header-number header) articles)
+ (setq highest-sequence-seen (max highest-sequence-seen this-sequence)))
+ (gnus-message 1 "Skipping article %s because it didn't match the Gnus Cloud method %s: %s"
+ (mail-header-number header)
+ gnus-cloud-storage-method
+ (mail-header-subject header))))))
(when articles
(nnimap-request-articles (nreverse articles) gnus-cloud-group-name)
(with-current-buffer nntp-server-buffer
@@ -480,7 +481,8 @@ Otherwise, returns the Gnus Cloud data chunks."
(push (gnus-cloud-parse-chunk) chunks)
(forward-line 1))))
(if update
- (mapcar #'gnus-cloud-update-all chunks)
+ (prog1 (mapcar #'gnus-cloud-update-all chunks)
+ (setq gnus-cloud-sequence highest-sequence-seen))
chunks)))
(defun gnus-cloud-server-p (server)
diff --git a/lisp/gnus/gnus-dbus.el b/lisp/gnus/gnus-dbus.el
new file mode 100644
index 00000000000..8fbeffba437
--- /dev/null
+++ b/lisp/gnus/gnus-dbus.el
@@ -0,0 +1,70 @@
+;;; gnus-dbus.el --- DBUS integration for Gnus -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library contains some Gnus integration for systems using DBUS.
+;; At present it registers a signal to close all Gnus servers before
+;; system sleep or hibernation.
+
+;;; Code:
+
+(require 'gnus)
+(require 'dbus)
+(declare-function gnus-close-all-servers "gnus-start")
+
+(defcustom gnus-dbus-close-on-sleep nil
+ "When non-nil, close Gnus servers on system sleep."
+ :group 'gnus-dbus
+ :type 'boolean)
+
+(defvar gnus-dbus-sleep-registration-object nil
+ "Object returned from `dbus-register-signal'.
+Used to unregister the signal.")
+
+(defun gnus-dbus-register-sleep-signal ()
+ "Use `dbus-register-signal' to close servers on sleep."
+ (when (featurep 'dbusbind)
+ (setq gnus-dbus-sleep-registration-object
+ (dbus-register-signal :system
+ "org.freedesktop.login1"
+ "/org/freedesktop/login1"
+ "org.freedesktop.login1.Manager"
+ "PrepareForSleep"
+ #'gnus-dbus-sleep-handler))
+ (gnus-add-shutdown #'gnus-dbus-unregister-sleep-signal 'gnus)))
+
+(defun gnus-dbus-sleep-handler (sleep-start)
+ ;; Sleep-start is t before sleeping.
+ (when (and sleep-start
+ (gnus-alive-p))
+ (condition-case nil
+ (gnus-close-all-servers)
+ (error nil))))
+
+(defun gnus-dbus-unregister-sleep-signal ()
+ (condition-case nil
+ (dbus-unregister-object
+ gnus-dbus-sleep-registration-object)
+ (wrong-type-argument nil)))
+
+(provide 'gnus-dbus)
+;;; gnus-dbus.el ends here
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index 8dae4ef5c17..63e938e7453 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -75,7 +75,11 @@ DELAY is a string, giving the length of the time. Possible values are:
variable `gnus-delay-default-hour', minute and second are zero.
* hh:mm for a specific time. Use 24h format. If it is later than this
- time, then the deadline is tomorrow, else today."
+ time, then the deadline is tomorrow, else today.
+
+The value of `message-draft-headers' determines which headers are
+generated when the article is delayed. Remaining headers are
+generated when the article is sent."
(interactive
(list (read-string
"Target date (YYYY-MM-DD), time (hh:mm), or length of delay (units in [mhdwMY]): "
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 1b25d247389..3a9bf2a7e8f 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -248,7 +248,7 @@ If DONT-POP is nil, display the buffer after setting it up."
(let ((article narticle))
(message-mail nil nil nil nil
(if dont-pop
- (lambda (buf) (set-buffer (get-buffer-create buf)))))
+ (lambda (buf) (set-buffer (gnus-get-buffer-create buf)))))
(let ((inhibit-read-only t))
(erase-buffer))
(if (not (gnus-request-restore-buffer article group))
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index 54118aad1e6..1bc1261ee8f 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -50,13 +50,13 @@
(defvar gnus-edit-form-buffer "*Gnus edit form*")
(defvar gnus-edit-form-done-function nil)
-(defvar gnus-edit-form-mode-map nil)
-(unless gnus-edit-form-mode-map
- (setq gnus-edit-form-mode-map (make-sparse-keymap))
- (set-keymap-parent gnus-edit-form-mode-map emacs-lisp-mode-map)
- (gnus-define-keys gnus-edit-form-mode-map
- "\C-c\C-c" gnus-edit-form-done
- "\C-c\C-k" gnus-edit-form-exit))
+(defvar gnus-edit-form-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map emacs-lisp-mode-map)
+ (gnus-define-keys map
+ "\C-c\C-c" gnus-edit-form-done
+ "\C-c\C-k" gnus-edit-form-exit)
+ map))
(defun gnus-edit-form-make-menu-bar ()
(unless (boundp 'gnus-edit-form-menu)
@@ -67,9 +67,9 @@
["Exit" gnus-edit-form-exit t]))
(gnus-run-hooks 'gnus-edit-form-menu-hook)))
-(define-derived-mode gnus-edit-form-mode fundamental-mode "Edit Form"
+(define-derived-mode gnus-edit-form-mode lisp-data-mode "Edit Form"
"Major mode for editing forms.
-It is a slightly enhanced emacs-lisp-mode.
+It is a slightly enhanced `lisp-data-mode'.
\\{gnus-edit-form-mode-map}"
(when (gnus-visual-p 'group-menu 'menu)
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index 33cbf4a54a9..3218649761a 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -40,7 +40,7 @@
"Regexp to match faces in `gnus-x-face-directory' to be omitted."
:version "25.1"
:group 'gnus-fun
- :type '(choice (const nil) string))
+ :type '(choice (const nil) regexp))
(defcustom gnus-face-directory (expand-file-name "faces" gnus-directory)
"Directory where Face PNG files are stored."
@@ -52,7 +52,7 @@
"Regexp to match faces in `gnus-face-directory' to be omitted."
:version "25.1"
:group 'gnus-fun
- :type '(choice (const nil) string))
+ :type '(choice (const nil) regexp))
(defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface"
"Command for converting a PBM to an X-Face."
@@ -205,11 +205,12 @@ different input formats."
(defun gnus-convert-face-to-png (face)
"Convert FACE (which is base64-encoded) to a PNG.
The PNG is returned as a string."
- (mm-with-unibyte-buffer
- (insert face)
- (ignore-errors
- (base64-decode-region (point-min) (point-max)))
- (buffer-string)))
+ (let ((face (gnus-base64-repad face nil nil t)))
+ (mm-with-unibyte-buffer
+ (insert face)
+ (ignore-errors
+ (base64-decode-region (point-min) (point-max)))
+ (buffer-string))))
;;;###autoload
(defun gnus-convert-png-to-face (file)
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index e2bd4ed860c..9c24de44cd6 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -109,14 +109,16 @@ callback for `gravatar-retrieve'."
;; If we're on the " quoting the name, go backward.
(when (looking-at-p "[\"<]")
(goto-char (1- (point))))
- ;; Do not do anything if there's already a gravatar. This can
- ;; happen if the buffer has been regenerated in the mean time, for
- ;; example we were fetching someaddress, and then we change to
- ;; another mail with the same someaddress.
- (unless (get-text-property (point) 'gnus-gravatar)
+ ;; Do not do anything if there's already a gravatar.
+ ;; This can happen if the buffer has been regenerated in
+ ;; the mean time, for example we were fetching
+ ;; someaddress, and then we change to another mail with
+ ;; the same someaddress.
+ (unless (get-text-property (1- (point)) 'gnus-gravatar)
(let ((pos (point)))
(setq gravatar (append gravatar gnus-gravatar-properties))
- (gnus-put-image gravatar (buffer-substring pos (1+ pos)) category)
+ (gnus-put-image gravatar (buffer-substring pos (1+ pos))
+ category)
(put-text-property pos (point) 'gnus-gravatar address)
(gnus-add-wash-type category)
(gnus-add-image category gravatar)))))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index b89f040b435..73fda66fb6b 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -49,11 +49,11 @@
(autoload 'gnus-agent-total-fetched-for "gnus-agent")
(autoload 'gnus-cache-total-fetched-for "gnus-cache")
-(autoload 'gnus-group-make-nnir-group "nnir")
-
(autoload 'gnus-cloud-upload-all-data "gnus-cloud")
(autoload 'gnus-cloud-download-all-data "gnus-cloud")
+(autoload 'gnus-topic-find-groups "gnus-topic")
+
(defcustom gnus-no-groups-message "No news is good news"
"Message displayed by Gnus when no groups are available."
:group 'gnus-start
@@ -663,7 +663,8 @@ simple manner."
"D" gnus-group-enter-directory
"f" gnus-group-make-doc-group
"w" gnus-group-make-web-group
- "G" gnus-group-make-nnir-group
+ "G" gnus-group-read-ephemeral-search-group
+ "g" gnus-group-make-search-group
"M" gnus-group-read-ephemeral-group
"r" gnus-group-rename-group
"R" gnus-group-make-rss-group
@@ -909,7 +910,8 @@ simple manner."
["Add the help group" gnus-group-make-help-group t]
["Make a doc group..." gnus-group-make-doc-group t]
["Make a web group..." gnus-group-make-web-group t]
- ["Make a search group..." gnus-group-make-nnir-group t]
+ ["Read a search group..." gnus-group-read-ephemeral-search-group t]
+ ["Make a search group..." gnus-group-make-search-group t]
["Make a virtual group..." gnus-group-make-empty-virtual t]
["Add a group to a virtual..." gnus-group-add-to-virtual t]
["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
@@ -1129,8 +1131,8 @@ The following commands are available:
(gnus-update-group-mark-positions)
(when gnus-use-undo
(gnus-undo-mode 1))
- (when gnus-slave
- (gnus-slave-mode)))
+ (when gnus-child
+ (gnus-child-mode)))
(defun gnus-update-group-mark-positions ()
(save-excursion
@@ -1768,7 +1770,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
(get-text-property (point-at-bol) 'gnus-unread))
(defun gnus-group-new-mail (group)
- (if (nnmail-new-mail-p (gnus-group-real-name group))
+ (if (nnmail-new-mail-p group)
gnus-new-mail-mark
?\s))
@@ -2411,13 +2413,13 @@ the bug number, and browsing the URL must return mbox output."
(require 'bug-reference)
(let ((def (cond ((thing-at-point-looking-at bug-reference-bug-regexp 500)
(match-string 2))
- ((number-at-point)))))
+ ((and (number-at-point)
+ (abs (number-at-point)))))))
;; Pass DEF as the value of COLLECTION instead of DEF because:
;; a) null input should not cause DEF to be returned and
;; b) TAB and M-n still work this way.
- (or (completing-read-multiple
- (format "Bug IDs%s: " (if def (format " (default %s)" def) ""))
- (and def (list (format "%s" def))))
+ (or (completing-read-multiple (format-prompt "Bug IDs" def)
+ (and def (list (format "%s" def))))
def)))
(defun gnus-read-ephemeral-bug-group (ids mbox-url &optional window-conf)
@@ -3165,6 +3167,113 @@ mail messages or news articles in files that have numeric names."
(gnus-group-real-name group)
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
+(autoload 'gnus-group-topic-name "gnus-topic")
+(autoload 'gnus-search-make-spec "gnus-search")
+
+;; Temporary to make group creation easier
+(defun gnus-group-make-search-group (no-parse &optional specs)
+ "Make a group based on a search.
+Prompt for a search query and determine the groups to search as
+follows: if called from the *Server* buffer search all groups
+belonging to the server on the current line; if called from the
+*Group* buffer search any marked groups, or the group on the
+current line, or all the groups under the current topic. A
+prefix arg NO-PARSE means that Gnus should not parse the search
+query before passing it to the underlying search engine. A
+non-nil SPECS arg must be an alist with `search-query-spec' and
+`search-group-spec' keys, and skips all prompting."
+ (interactive "P")
+ (let ((name (gnus-read-group "Group name: ")))
+ (with-current-buffer gnus-group-buffer
+ (let* ((group-spec
+ (or
+ (cdr (assq 'search-group-spec specs))
+ (cdr (assq 'nnir-group-spec specs))
+ (if (gnus-server-server-name)
+ (list (list (gnus-server-server-name)))
+ (seq-group-by
+ (lambda (elt) (gnus-group-server elt))
+ (or gnus-group-marked
+ (if (gnus-group-group-name)
+ (list (gnus-group-group-name))
+ (mapcar #'caadr
+ (gnus-topic-find-groups
+ (gnus-group-topic-name)
+ nil 'all nil t))))))))
+ (query-spec
+ (or
+ (cdr (assq 'search-query-spec specs))
+ (cdr (assq 'nnir-query-spec specs))
+ (gnus-search-make-spec no-parse))))
+ ;; If our query came via an old call to nnir, we know not to
+ ;; parse the query.
+ (when (assq 'nnir-query-spec specs)
+ (setf (alist-get 'raw query-spec) t))
+ (gnus-group-make-group
+ name
+ (list 'nnselect "nnselect")
+ nil
+ (list
+ (cons 'nnselect-specs
+ (list
+ (cons 'nnselect-function 'gnus-search-run-query)
+ (cons 'nnselect-args
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec)))))
+ (cons 'nnselect-artlist nil)))))))
+
+(define-obsolete-function-alias 'gnus-group-make-nnir-group
+ 'gnus-group-read-ephemeral-search-group "28.1")
+
+(defun gnus-group-read-ephemeral-search-group (no-parse &optional specs)
+ "Read an nnselect group based on a search.
+Prompt for a search query and determine the groups to search as
+follows: if called from the *Server* buffer search all groups
+belonging to the server on the current line; if called from the
+*Group* buffer search any marked groups, or the group on the
+current line, or all the groups under the current topic. A
+prefix arg NO-PARSE means that Gnus should not parse the search
+query before passing it to the underlying search engine. A
+non-nil SPECS arg must be an alist with `search-query-spec' and
+`search-group-spec' keys, and skips all prompting."
+ (interactive "P")
+ (let* ((group-spec
+ (or (cdr (assq 'search-group-spec specs))
+ (cdr (assq 'nnir-group-spec specs))
+ (if (gnus-server-server-name)
+ (list (list (gnus-server-server-name)))
+ (seq-group-by
+ (lambda (elt) (gnus-group-server elt))
+ (or gnus-group-marked
+ (if (gnus-group-group-name)
+ (list (gnus-group-group-name))
+ (mapcar #'caadr
+ (gnus-topic-find-groups
+ (gnus-group-topic-name)
+ nil 'all nil t))))))))
+ (query-spec
+ (or (cdr (assq 'search-query-spec specs))
+ (cdr (assq 'nnir-query-spec specs))
+ (gnus-search-make-spec no-parse))))
+ ;; If our query came via an old call to nnir, we know not to parse
+ ;; the query.
+ (when (assq 'nnir-query-spec specs)
+ (setf (alist-get 'raw query-spec) t))
+ (gnus-group-read-ephemeral-group
+ (concat "nnselect-" (message-unique-id))
+ (list 'nnselect "nnselect")
+ nil
+ (cons (current-buffer) gnus-current-window-configuration)
+ nil nil
+ (list
+ (cons 'nnselect-specs
+ (list
+ (cons 'nnselect-function 'gnus-search-run-query)
+ (cons 'nnselect-args
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec)))))
+ (cons 'nnselect-artlist nil)))))
+
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."
(interactive
@@ -3600,7 +3709,7 @@ or nil if no action could be taken."
(marks (gnus-info-marks (nth 1 entry)))
(unread (gnus-sequence-of-unread-articles group)))
;; Remove entries for this group.
- (nnmail-purge-split-history (gnus-group-real-name group))
+ (nnmail-purge-split-history group)
;; Do the updating only if the newsgroup isn't killed.
(if (not (numberp (car entry)))
(gnus-message 1 "Can't catch up %s; non-active group" group)
@@ -3697,9 +3806,8 @@ Uses the process/prefix convention."
(error "No group on the current line"))
(string-to-number
(let ((s (read-string
- (format "Level (default %s): "
- (or (gnus-group-group-level)
- gnus-level-default-subscribed)))))
+ (format-prompt "Level" (or (gnus-group-group-level)
+ gnus-level-default-subscribed)))))
(if (string-match "^\\s-*$" s)
(int-to-string (or (gnus-group-group-level)
gnus-level-default-subscribed))
@@ -3761,10 +3869,10 @@ group line."
(newsrc
;; Toggle subscription flag.
(gnus-group-change-level
- newsrc (if level level (if (<= (gnus-info-level (nth 1 newsrc))
- gnus-level-subscribed)
- (1+ gnus-level-subscribed)
- gnus-level-default-subscribed)))
+ newsrc (or level (if (<= (gnus-info-level (nth 1 newsrc))
+ gnus-level-subscribed)
+ (1+ gnus-level-subscribed)
+ gnus-level-default-subscribed)))
(unless silent
(gnus-group-update-group group)))
((and (stringp group)
@@ -3773,7 +3881,7 @@ group line."
;; Add new newsgroup.
(gnus-group-change-level
group
- (if level level gnus-level-default-subscribed)
+ (or level gnus-level-default-subscribed)
(or (and (member group gnus-zombie-list)
gnus-level-zombie)
gnus-level-killed)
@@ -4024,9 +4132,9 @@ otherwise all levels below ARG will be scanned too."
(gnus-run-hooks 'gnus-get-top-new-news-hook)
(gnus-run-hooks 'gnus-get-new-news-hook)
- ;; Read any slave files.
- (unless gnus-slave
- (gnus-master-read-slave-newsrc))
+ ;; Read any child files.
+ (unless gnus-child
+ (gnus-parent-read-child-newsrc))
(gnus-get-unread-articles (gnus-group-default-level arg t)
nil one-level)
@@ -4300,8 +4408,7 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending."
;; Closing all the backends is useful (for instance) when when the
;; IP addresses have changed and you need to reconnect.
(dolist (elem gnus-opened-servers)
- (gnus-close-server (car elem))
- (setcar (cdr elem) 'closed))
+ (gnus-close-server (car elem)))
(when group-buf
(bury-buffer group-buf)
(delete-windows-on group-buf t))))
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index ee556a32080..389bce85e8b 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -5,18 +5,20 @@
;; Author: Jan Tatarik <Jan.Tatarik@gmail.com>
;; Keywords: mail, icalendar, org
-;; This program is free software; you can redistribute it and/or modify
+;; 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.
-;; This program is distributed in the hope that it will be useful,
+;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -132,11 +134,27 @@
(cl-defmethod gnus-icalendar-event:recurring-interval ((event gnus-icalendar-event))
"Return recurring interval of EVENT."
(let ((rrule (gnus-icalendar-event:recur event))
- (default-interval 1))
+ (default-interval "1"))
+
+ (if (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule)
+ (match-string 1 rrule)
+ default-interval)))
- (string-match "INTERVAL=\\([[:digit:]]+\\)" rrule)
- (or (match-string 1 rrule)
- default-interval)))
+(cl-defmethod gnus-icalendar-event:recurring-days ((event gnus-icalendar-event))
+ "Return, when available, the week day numbers on which the EVENT recurs."
+ (let ((rrule (gnus-icalendar-event:recur event))
+ (weekday-map '(("SU" . 0)
+ ("MO" . 1)
+ ("TU" . 2)
+ ("WE" . 3)
+ ("TH" . 4)
+ ("FR" . 5)
+ ("SA" . 6))))
+ (when (and rrule (string-match "BYDAY=\\([^;]+\\)" rrule))
+ (let ((bydays (split-string (match-string 1 rrule) ",")))
+ (seq-map
+ (lambda (x) (cdr (assoc x weekday-map)))
+ (seq-filter (lambda (x) (string-match "^[A-Z]\\{2\\}$" x)) bydays))))))
(cl-defmethod gnus-icalendar-event:start ((event gnus-icalendar-event))
(format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event)))
@@ -162,8 +180,10 @@
(or (member (attendee-name prop) name-or-email)
(let ((att-email (attendee-email prop)))
(gnus-icalendar-find-if
- (lambda (email)
- (string-match email att-email))
+ (lambda (str-or-fun)
+ (if (functionp str-or-fun)
+ (funcall str-or-fun att-email)
+ (string-match str-or-fun att-email)))
name-or-email))))))
(gnus-icalendar-find-if #'attendee-prop-matches-p event-props))))
@@ -244,7 +264,14 @@
(map-property ical-property))
args)))))
(mapc #'accumulate-args prop-map)
- (apply #'make-instance event-class args))))
+ (apply
+ #'make-instance
+ event-class
+ (cl-loop for slot in (eieio-class-slots event-class)
+ for keyword = (intern
+ (format ":%s" (eieio-slot-descriptor-name slot)))
+ when (plist-member args keyword)
+ append (list keyword (plist-get args keyword)))))))
(defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email)
"Parse RFC5545 iCalendar in buffer BUF and return an event object.
@@ -312,7 +339,8 @@ status will be retrieved from the first matching attendee record."
(unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x))
reply-event-lines)
- (error "Could not find an event attendee matching given identity"))
+ (lwarn 'gnus-icalendar :warning
+ "Could not find an event attendee matching given identity"))
(mapconcat #'identity `("BEGIN:VEVENT"
,@(nreverse reply-event-lines)
@@ -400,21 +428,26 @@ Return nil for non-recurring EVENT."
(when org-freq
(format "+%s%s" (gnus-icalendar-event:recurring-interval event) org-freq)))))
-(cl-defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event))
- "Build `org-mode' timestamp from EVENT start/end dates and recurrence info."
- (let* ((start (gnus-icalendar-event:start-time event))
- (end (gnus-icalendar-event:end-time event))
- (start-date (format-time-string "%Y-%m-%d" start))
+(defun gnus-icalendar--find-day (start-date end-date day)
+ (let ((time-1-day 86400))
+ (if (= (decoded-time-weekday (decode-time start-date))
+ day)
+ (list start-date end-date)
+ (gnus-icalendar--find-day (time-add start-date time-1-day)
+ (time-add end-date time-1-day)
+ day))))
+
+(defun gnus-icalendar-event--org-timestamp (start end org-repeat)
+ (let* ((start-date (format-time-string "%Y-%m-%d" start))
(start-time (format-time-string "%H:%M" start))
(start-at-midnight (string= start-time "00:00"))
(end-date (format-time-string "%Y-%m-%d" end))
(end-time (format-time-string "%H:%M" end))
(end-at-midnight (string= end-time "00:00"))
(start-end-date-diff
- (time-to-number-of-days (time-subtract
- (org-time-string-to-time end-date)
- (org-time-string-to-time start-date))))
- (org-repeat (gnus-icalendar-event:org-repeat event))
+ (time-to-number-of-days
+ (time-subtract (org-time-string-to-time end-date)
+ (org-time-string-to-time start-date))))
(repeat (if org-repeat (concat " " org-repeat) ""))
(time-1-day 86400))
@@ -445,7 +478,31 @@ Return nil for non-recurring EVENT."
;; A .:. - A .:. -> A .:.-.:.
;; A .:. - B .:.
((zerop start-end-date-diff) (format "<%s %s-%s%s>" start-date start-time end-time repeat))
- (t (format "<%s %s>--<%s %s>" start-date start-time end-date end-time)))))
+ (t (format "<%s %s>--<%s %s>" start-date start-time end-date end-time))))
+ )
+
+(cl-defmethod gnus-icalendar-event:org-timestamp ((event gnus-icalendar-event))
+ "Build `org-mode' timestamp from EVENT start/end dates and recurrence info."
+ ;; if org-repeat +1d or +1w and byday: generate one timestamp per
+ ;; byday, starting at start-date. Change +1d to +7d.
+ (let ((start (gnus-icalendar-event:start-time event))
+ (end (gnus-icalendar-event:end-time event))
+ (org-repeat (gnus-icalendar-event:org-repeat event))
+ (recurring-days (gnus-icalendar-event:recurring-days event)))
+ (if (and (or (string= org-repeat "+1d")
+ (string= org-repeat "+1w"))
+ recurring-days)
+ (let ((repeat "+1w")
+ (dates (seq-sort-by
+ 'car
+ 'time-less-p
+ (seq-map (lambda (x)
+ (gnus-icalendar--find-day start end x))
+ recurring-days))))
+ (mapconcat (lambda (x)
+ (gnus-icalendar-event--org-timestamp (car x) (cadr x)
+ repeat)) dates "\n"))
+ (gnus-icalendar-event--org-timestamp start end org-repeat))))
(defun gnus-icalendar--format-summary-line (summary &optional location)
(if location
@@ -715,9 +772,8 @@ These will be used to retrieve the RSVP information from ical events."
(lambda (x) (if (listp x) x (list x)))
(list user-full-name (regexp-quote user-mail-address)
;; NOTE: these can be lists
- gnus-ignored-from-addresses ; already regexp-quoted
- (unless (functionp message-alternative-emails) ; String or function.
- message-alternative-emails)
+ gnus-ignored-from-addresses ; String or function.
+ message-alternative-emails ; String or function.
(mapcar #'regexp-quote gnus-icalendar-additional-identities)))))
;; TODO: make the template customizable
@@ -756,7 +812,7 @@ These will be used to retrieve the RSVP information from ical events."
`(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle)))))
(with-temp-buffer
(mm-insert-part ,handle)
- (when (string= (downcase ,charset) "utf-8")
+ (when (and ,charset (string= (downcase ,charset) "utf-8"))
(decode-coding-region (point-min) (point-max) 'utf-8))
,@body))))
@@ -814,7 +870,7 @@ These will be used to retrieve the RSVP information from ical events."
(let ((subject (concat (capitalize (symbol-name status))
": " (gnus-icalendar-event:summary event))))
- (with-current-buffer (get-buffer-create gnus-icalendar-reply-bufname)
+ (with-current-buffer (gnus-get-buffer-create gnus-icalendar-reply-bufname)
(delete-region (point-min) (point-max))
(insert reply)
(fold-icalendar-buffer)
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index c304f575d92..b8be766c84f 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -253,7 +253,7 @@ If it is down, start it up (again)."
(defun gnus-backend-trace (type form)
(when gnus-backend-trace
- (with-current-buffer (get-buffer-create "*gnus trace*")
+ (with-current-buffer (gnus-get-buffer-create "*gnus trace*")
(buffer-disable-undo)
(goto-char (point-max))
(insert (format-time-string "%H:%M:%S")
@@ -351,9 +351,12 @@ If it is down, start it up (again)."
"Close the connection to GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'close-server)
- (nth 1 gnus-command-method)
- (nthcdr 2 gnus-command-method)))
+ (prog1
+ (funcall (gnus-get-function gnus-command-method 'close-server)
+ (nth 1 gnus-command-method)
+ (nthcdr 2 gnus-command-method))
+ (when-let ((elem (assoc gnus-command-method gnus-opened-servers)))
+ (setf (nth 1 elem) 'closed))))
(defun gnus-request-list (gnus-command-method)
"Request the active file from GNUS-COMMAND-METHOD."
@@ -362,6 +365,48 @@ If it is down, start it up (again)."
(funcall (gnus-get-function gnus-command-method 'request-list)
(nth 1 gnus-command-method)))
+(defun gnus-server-get-active (server &optional ignored)
+ "Return the active list for SERVER.
+Groups matching the IGNORED regexp are excluded."
+ (let ((method (gnus-server-to-method server))
+ groups)
+ (gnus-request-list method)
+ (with-current-buffer nntp-server-buffer
+ (let ((cur (current-buffer)))
+ (goto-char (point-min))
+ (unless (or (null ignored)
+ (string= ignored ""))
+ (delete-matching-lines ignored))
+ (if (eq (car method) 'nntp)
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-full-name
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point)))
+ method)
+ groups))
+ (forward-line))
+ (while (not (eobp))
+ (ignore-errors
+ (push (if (eq (char-after) ?\")
+ (gnus-group-full-name (read cur) method)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ (gnus-group-full-name name method)))
+ groups))
+ (forward-line)))))
+ groups))
+
(defun gnus-finish-retrieve-group-infos (gnus-command-method infos data)
"Read and update infos from GNUS-COMMAND-METHOD."
(when (stringp gnus-command-method)
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index 5edbaaf201b..a772281d4c3 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -653,7 +653,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
gnus-options-not-subscribe)
;; Eat all arguments.
(setq command-line-args-left nil)
- (gnus-slave)
+ (gnus-child)
;; Apply kills to specified newsgroups in command line arguments.
(setq newsrc (cdr gnus-newsrc-alist))
(while (setq info (pop newsrc))
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index daaea3980b5..465871eafbd 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -393,10 +393,9 @@ only affect the Gcc copy, but not the original message."
(gnus-inews-make-draft-meta-information
,gnus-newsgroup-name ',articles)))
-(autoload 'nnir-article-number "nnir" nil nil 'macro)
-(autoload 'nnir-article-group "nnir" nil nil 'macro)
-(autoload 'gnus-nnir-group-p "nnir")
-
+(autoload 'nnselect-article-number "nnselect" nil nil 'macro)
+(autoload 'nnselect-article-group "nnselect" nil nil 'macro)
+(autoload 'gnus-nnselect-group-p "nnselect")
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
@@ -404,22 +403,24 @@ only affect the Gcc copy, but not the original message."
(winconf-name (make-symbol "gnus-setup-message-winconf-name"))
(buffer (make-symbol "gnus-setup-message-buffer"))
(article (make-symbol "gnus-setup-message-article"))
+ (oarticle (make-symbol "gnus-setup-message-oarticle"))
(yanked (make-symbol "gnus-setup-yanked-articles"))
(group (make-symbol "gnus-setup-message-group")))
`(let ((,winconf (current-window-configuration))
(,winconf-name gnus-current-window-configuration)
(,buffer (buffer-name (current-buffer)))
- (,article (if (and (gnus-nnir-group-p gnus-newsgroup-name)
- gnus-article-reply)
- (nnir-article-number (or (car-safe gnus-article-reply)
- gnus-article-reply))
- gnus-article-reply))
+ (,article (when gnus-article-reply
+ (or (nnselect-article-number
+ (or (car-safe gnus-article-reply)
+ gnus-article-reply))
+ gnus-article-reply)))
+ (,oarticle gnus-article-reply)
(,yanked gnus-article-yanked-articles)
- (,group (if (and (gnus-nnir-group-p gnus-newsgroup-name)
- gnus-article-reply)
- (nnir-article-group (or (car-safe gnus-article-reply)
- gnus-article-reply))
- gnus-newsgroup-name))
+ (,group (when gnus-article-reply
+ (or (nnselect-article-group
+ (or (car-safe gnus-article-reply)
+ gnus-article-reply))
+ gnus-newsgroup-name)))
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
(mbl mml-buffer-list)
@@ -460,24 +461,23 @@ only affect the Gcc copy, but not the original message."
(unwind-protect
(progn
,@forms)
- (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+ (gnus-inews-add-send-actions ,winconf ,buffer ,oarticle ,config
,yanked ,winconf-name)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
- (set (make-local-variable 'gnus-newsgroup-name) ,group)
- ;; Enable highlighting of different citation levels
- (when gnus-message-highlight-citation
- (gnus-message-citation-mode 1))
- (gnus-run-hooks 'gnus-message-setup-hook)
- (if (eq major-mode 'message-mode)
- (let ((mbl1 mml-buffer-list))
- (setq mml-buffer-list mbl) ;; Global value
- (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
- (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
- (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
- (mml-destroy-buffers)
- (setq mml-buffer-list mbl)))
+ ;; Enable highlighting of different citation levels
+ (when gnus-message-highlight-citation
+ (gnus-message-citation-mode 1))
+ (gnus-run-hooks 'gnus-message-setup-hook)
+ (if (eq major-mode 'message-mode)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl) ;; Global value
+ (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
+ (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
+ (mml-destroy-buffers)
+ (setq mml-buffer-list mbl)))
(message-hide-headers)
(gnus-add-buffer)
(gnus-configure-windows ,config t)
@@ -521,12 +521,10 @@ instead."
mail-buf)
(unwind-protect
(progn
- (setq gnus-newsgroup-name "")
+ (let ((gnus-newsgroup-name ""))
(gnus-setup-message 'message
(message-mail to subject other-headers continue
- nil yank-action send-actions return-action)))
- (with-current-buffer buf
- (setq gnus-newsgroup-name group-name)))
+ nil yank-action send-actions return-action)))))
(when switch-action
(setq mail-buf (current-buffer))
(switch-to-buffer buf)
@@ -617,18 +615,15 @@ If ARG is 1, prompt for a group name to find the posting style."
(buffer (current-buffer)))
(unwind-protect
(progn
- (setq gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (gnus-group-completing-read
- "Use posting style of group"
- nil (gnus-read-active-file-p))
- (gnus-group-group-name))
- ""))
- ;; #### see comment in gnus-setup-message -- drv
- (gnus-setup-message 'message (message-mail)))
- (with-current-buffer buffer
- (setq gnus-newsgroup-name group)))))
+ (let ((gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (gnus-group-completing-read
+ "Use posting style of group"
+ nil (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ "")))
+ (gnus-setup-message 'message (message-mail)))))))
(defun gnus-group-news (&optional arg)
"Start composing a news.
@@ -647,19 +642,16 @@ network. The corresponding back end must have a `request-post' method."
(buffer (current-buffer)))
(unwind-protect
(progn
- (setq gnus-newsgroup-name
+ (let ((gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read "Use group"
nil
(gnus-read-active-file-p))
(gnus-group-group-name))
- ""))
- ;; #### see comment in gnus-setup-message -- drv
+ "")))
(gnus-setup-message 'message
- (message-news (gnus-group-real-name gnus-newsgroup-name))))
- (with-current-buffer buffer
- (setq gnus-newsgroup-name group)))))
+ (message-news (gnus-group-real-name gnus-newsgroup-name))))))))
(defun gnus-group-post-news (&optional arg)
"Start composing a message (a news by default).
@@ -694,18 +686,15 @@ posting style."
(buffer (current-buffer)))
(unwind-protect
(progn
- (setq gnus-newsgroup-name
+ (let ((gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read "Use group"
nil
(gnus-read-active-file-p))
"")
- gnus-newsgroup-name))
- ;; #### see comment in gnus-setup-message -- drv
- (gnus-setup-message 'message (message-mail)))
- (with-current-buffer buffer
- (setq gnus-newsgroup-name group)))))
+ gnus-newsgroup-name)))
+ (gnus-setup-message 'message (message-mail)))))))
(defun gnus-summary-news-other-window (&optional arg)
"Start composing a news in another window.
@@ -724,24 +713,21 @@ network. The corresponding back end must have a `request-post' method."
(buffer (current-buffer)))
(unwind-protect
(progn
- (setq gnus-newsgroup-name
+ (let ((gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read "Use group"
nil
(gnus-read-active-file-p))
"")
- gnus-newsgroup-name))
- ;; #### see comment in gnus-setup-message -- drv
+ gnus-newsgroup-name)))
(gnus-setup-message 'message
(progn
(message-news (gnus-group-real-name gnus-newsgroup-name))
(set (make-local-variable 'gnus-discouraged-post-methods)
(remove
(car (gnus-find-method-for-group gnus-newsgroup-name))
- gnus-discouraged-post-methods)))))
- (with-current-buffer buffer
- (setq gnus-newsgroup-name group)))))
+ gnus-discouraged-post-methods)))))))))
(defun gnus-summary-post-news (&optional arg)
"Start composing a message. Post to the current group by default.
@@ -823,7 +809,7 @@ active, the entire article will be yanked."
(with-current-buffer gnus-article-copy
(save-restriction
(nnheader-narrow-to-headers)
- (nnheader-parse-naked-head)))))
+ (nnheader-parse-head t)))))
(message-yank-original)
(message-exchange-point-and-mark)
(setq beg (or beg (mark t))))
@@ -1366,8 +1352,10 @@ For the \"inline\" alternatives, also see the variable
gcc)))
(insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")))))))
-(defun gnus-summary-resend-message (address n)
- "Resend the current article to ADDRESS."
+(defun gnus-summary-resend-message (address n &optional no-select)
+ "Resend the current article to ADDRESS.
+Uses the process/prefix convention. If NO-SELECT, don't display
+the message before resending."
(interactive
(list (message-read-from-minibuffer
"Resend message(s) to: "
@@ -1386,6 +1374,7 @@ For the \"inline\" alternatives, also see the variable
'posting-style t))
(user-full-name user-full-name)
(user-mail-address user-mail-address)
+ (group gnus-newsgroup-name)
tem)
(dolist (style styles)
(when (stringp (cadr style))
@@ -1409,11 +1398,18 @@ For the \"inline\" alternatives, also see the variable
'(gnus-agent-possibly-do-gcc)
'(gnus-inews-do-gcc)))))
(dolist (article (gnus-summary-work-articles n))
- (gnus-summary-select-article nil nil nil article)
- (with-current-buffer gnus-original-article-buffer
- (let ((gnus-gcc-externalize-attachments nil)
- (message-inhibit-body-encoding t))
- (message-resend address)))
+ (if no-select
+ (with-current-buffer " *nntpd*"
+ (erase-buffer)
+ (gnus-request-article article group)
+ (let ((gnus-gcc-externalize-attachments nil)
+ (message-inhibit-body-encoding t))
+ (message-resend address)))
+ (gnus-summary-select-article nil nil nil article)
+ (with-current-buffer gnus-original-article-buffer
+ (let ((gnus-gcc-externalize-attachments nil)
+ (message-inhibit-body-encoding t))
+ (message-resend address))))
(gnus-summary-mark-article-as-forwarded article))))
;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
@@ -1510,7 +1506,11 @@ If YANK is non-nil, include the original article."
(gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
(defun gnus-bug (subject)
- "Send a bug report to the Emacs maintainers."
+ "Send a bug report to the Emacs maintainers.
+
+Already submitted bugs can be found in the Emacs bug tracker:
+
+ https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1"
(interactive "sBug Subject: ")
(report-emacs-bug subject)
(save-excursion
@@ -1594,7 +1594,7 @@ this is a reply."
(message-remove-header "gcc")
(widen)
(setq groups (message-unquote-tokens
- (message-tokenize-header gcc " ,")))
+ (message-tokenize-header gcc " ,\n\t")))
;; Copy the article over to some group(s).
(while (setq group (pop groups))
(setq method (gnus-inews-group-method group)
@@ -1989,10 +1989,10 @@ process-mark several articles, they will all be attached."
(gnus-summary-iterate n
(gnus-summary-select-article)
(with-current-buffer destination
- ;; Attach at the end of the buffer.
- (save-excursion
- (goto-char (point-max))
- (message-forward-make-body-mime gnus-original-article-buffer))))
+ ;; Attach at the end of the buffer.
+ (save-excursion
+ (goto-char (point-max))
+ (message-forward-make-body-mime gnus-original-article-buffer))))
(gnus-configure-windows 'message t)))
(provide 'gnus-msg)
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index fd2b44f7424..65bcd0e8a36 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -1,4 +1,4 @@
-;;; gnus-registry.el --- article registry for Gnus
+;;; gnus-registry.el --- article registry for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@@ -62,10 +62,10 @@
;; show the marks as single characters (see the :char property in
;; `gnus-registry-marks'):
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
+;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars)
;; show the marks by name (see `gnus-registry-marks'):
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
+;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names)
;; TODO:
@@ -427,6 +427,8 @@ This is not required after changing `gnus-registry-cache-file'."
(gnus-message 4 "Removed %d ignored entries from the Gnus registry"
(- old-size (registry-size db)))))
+(declare-function gnus-nnselect-group-p "nnselect" (group))
+(declare-function nnselect-article-group "nnselect" (article))
;; article move/copy/spool/delete actions
(defun gnus-registry-action (action data-header from &optional to method)
(let* ((id (mail-header-id data-header))
@@ -437,7 +439,10 @@ This is not required after changing `gnus-registry-cache-file'."
(or (cdr-safe (assq 'To extra)) "")))
(sender (nth 0 (gnus-registry-extract-addresses
(mail-header-from data-header))))
- (from (gnus-group-guess-full-name-from-command-method from))
+ (from (gnus-group-guess-full-name-from-command-method
+ (if (gnus-nnselect-group-p from)
+ (nnselect-article-group (mail-header-number data-header))
+ from)))
(to (if to (gnus-group-guess-full-name-from-command-method to) nil)))
(gnus-message 7 "Gnus registry: article %s %s from %s to %s"
id (if method "respooling" "going") from to)
@@ -449,19 +454,21 @@ This is not required after changing `gnus-registry-cache-file'."
to subject sender recipients)))
(defun gnus-registry-spool-action (id group &optional subject sender recipients)
- (let ((to (gnus-group-guess-full-name-from-command-method group))
- (recipients (or recipients
- (gnus-registry-sort-addresses
- (or (message-fetch-field "cc") "")
- (or (message-fetch-field "to") ""))))
- (subject (or subject (message-fetch-field "subject")))
- (sender (or sender (message-fetch-field "from"))))
- (when (and (stringp id) (string-match "\r$" id))
- (setq id (substring id 0 -1)))
- (gnus-message 7 "Gnus registry: article %s spooled to %s"
- id
- to)
- (gnus-registry-handle-action id nil to subject sender recipients)))
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (let ((to (gnus-group-guess-full-name-from-command-method group))
+ (recipients (or recipients
+ (gnus-registry-sort-addresses
+ (or (message-fetch-field "cc") "")
+ (or (message-fetch-field "to") ""))))
+ (subject (or subject (message-fetch-field "subject")))
+ (sender (or sender (message-fetch-field "from"))))
+ (when (and (stringp id) (string-match "\r$" id))
+ (setq id (substring id 0 -1)))
+ (gnus-message 7 "Gnus registry: article %s spooled to %s"
+ id
+ to)
+ (gnus-registry-handle-action id nil to subject sender recipients))))
(defun gnus-registry-handle-action (id from to subject sender
&optional recipients)
@@ -485,23 +492,25 @@ This is not required after changing `gnus-registry-cache-file'."
(when from
(setq entry (cons (delete from (assoc 'group entry))
(assq-delete-all 'group entry))))
-
- (dolist (kv `((group ,to)
- (sender ,sender)
- (recipient ,@recipients)
- (subject ,subject)))
- (when (cadr kv)
- (let ((new (or (assq (car kv) entry)
- (list (car kv)))))
- (dolist (toadd (cdr kv))
- (unless (member toadd new)
- (setq new (append new (list toadd)))))
- (setq entry (cons new
- (assq-delete-all (car kv) entry))))))
- (gnus-message 10 "Gnus registry: new entry for %s is %S"
- id
- entry)
- (gnus-registry-insert db id entry)))
+ ;; Only keep the entry if the message is going to a new group, or
+ ;; it's still in some previous group.
+ (when (or to (alist-get 'group entry))
+ (dolist (kv `((group ,to)
+ (sender ,sender)
+ (recipient ,@recipients)
+ (subject ,subject)))
+ (when (cadr kv)
+ (let ((new (or (assq (car kv) entry)
+ (list (car kv)))))
+ (dolist (toadd (cdr kv))
+ (unless (member toadd new)
+ (setq new (append new (list toadd)))))
+ (setq entry (cons new
+ (assq-delete-all (car kv) entry))))))
+ (gnus-message 10 "Gnus registry: new entry for %s is %S"
+ id
+ entry)
+ (gnus-registry-insert db id entry))))
;; Function for nn{mail|imap}-split-fancy: look up all references in
;; the cache and if a match is found, return that group.
@@ -588,7 +597,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
subject
(< gnus-registry-minimum-subject-length (length subject)))
(let ((groups (apply
- 'append
+ #'append
(mapcar
(lambda (reference)
(gnus-registry-get-id-key reference 'group))
@@ -615,7 +624,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
sender
gnus-registry-unfollowed-addresses)))
(let ((groups (apply
- 'append
+ #'append
(mapcar
(lambda (reference)
(gnus-registry-get-id-key reference 'group))
@@ -644,7 +653,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(not (gnus-grep-in-list
recp
gnus-registry-unfollowed-addresses)))
- (let ((groups (apply 'append
+ (let ((groups (apply #'append
(mapcar
(lambda (reference)
(gnus-registry-get-id-key reference 'group))
@@ -663,7 +672,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
;; filter the found groups and return them
;; the found groups are NOT the full groups
(setq found (gnus-registry-post-process-groups
- "recipients" (mapconcat 'identity recipients ", ") found)))
+ "recipients" (mapconcat #'identity recipients ", ") found)))
;; after the (cond) we extract the actual value safely
(car-safe found)))
@@ -784,14 +793,15 @@ Consults `gnus-registry-unfollowed-groups' and
Consults `gnus-registry-ignored-groups' and
`nnmail-split-fancy-with-parent-ignore-groups'."
(and group
- (or (gnus-grep-in-list
+ (or (gnus-virtual-group-p group) (gnus-grep-in-list
group
(delq nil (mapcar (lambda (g)
(cond
((stringp g) g)
((and (listp g) (nth 1 g))
(nth 0 g))
- (t nil))) gnus-registry-ignored-groups)))
+ (t nil)))
+ gnus-registry-ignored-groups)))
;; only use `gnus-parameter-registry-ignore' if
;; `gnus-registry-ignored-groups' is a list of lists
;; (it can be a list of regexes)
@@ -871,7 +881,7 @@ Addresses without a name will say \"noname\"."
(defun gnus-registry-sort-addresses (&rest addresses)
"Return a normalized and sorted list of ADDRESSES."
- (sort (mapcan 'gnus-registry-extract-addresses addresses) 'string-lessp))
+ (sort (mapcan #'gnus-registry-extract-addresses addresses) 'string-lessp))
(defun gnus-registry-simplify-subject (subject)
(if (stringp subject)
@@ -961,16 +971,15 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
(intern (format function-format variant-name)))
(shortcut (format "%c" (if remove (upcase data) data))))
(defalias function-name
- ;; If it weren't for the function's docstring, we could
- ;; use a closure, with lexical-let :-(
- `(lambda (&rest articles)
- ,(format
- "%s the %s mark over process-marked ARTICLES."
- (upcase-initials variant-name)
- mark)
- (interactive
- (gnus-summary-work-articles current-prefix-arg))
- (gnus-registry--set/remove-mark ',mark ',remove articles)))
+ (lambda (&rest articles)
+ (:documentation
+ (format
+ "%s the %s mark over process-marked ARTICLES."
+ (upcase-initials variant-name)
+ mark))
+ (interactive
+ (gnus-summary-work-articles current-prefix-arg))
+ (gnus-registry--set/remove-mark mark remove articles)))
(push function-name keys-plist)
(push shortcut keys-plist)
(push (vector (format "%s %s"
@@ -990,14 +999,11 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
nil
(cons "Registry Marks" gnus-registry-misc-menus))))))
-(make-obsolete 'gnus-registry-user-format-function-M
- 'gnus-registry-article-marks-to-chars "24.1") ?
-
-(defalias 'gnus-registry-user-format-function-M
- 'gnus-registry-article-marks-to-chars)
+(define-obsolete-function-alias 'gnus-registry-user-format-function-M
+ #'gnus-registry-article-marks-to-chars "24.1")
;; use like this:
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars)
+;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars)
(defun gnus-registry-article-marks-to-chars (headers)
"Show the marks for an article by the :char property."
(if gnus-registry-enabled
@@ -1013,20 +1019,20 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
""))
;; use like this:
-;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-names)
+;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names)
(defun gnus-registry-article-marks-to-names (headers)
"Show the marks for an article by name."
(if gnus-registry-enabled
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-get-id-key id 'mark))))
- (mapconcat (lambda (mark) (symbol-name mark)) marks ","))
+ (mapconcat #'symbol-name marks ","))
""))
(defun gnus-registry-read-mark ()
"Read a mark name from the user with completion."
(let ((mark (gnus-completing-read
"Label"
- (mapcar 'symbol-name (mapcar 'car gnus-registry-marks))
+ (mapcar #'symbol-name (mapcar #'car gnus-registry-marks))
nil nil nil
(symbol-name gnus-registry-default-mark))))
(when (stringp mark)
@@ -1050,7 +1056,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
show-message)
"Apply or remove MARK across a list of ARTICLES."
(let ((article-id-list
- (mapcar 'gnus-registry-fetch-message-id-fast articles)))
+ (mapcar #'gnus-registry-fetch-message-id-fast articles)))
(dolist (id article-id-list)
(let* ((marks (delq mark (gnus-registry-get-id-key id 'mark)))
(marks (if remove marks (cons mark marks))))
@@ -1173,34 +1179,34 @@ only the last one's marks are returned."
(gnus-registry-install-shortcuts)
(if (gnus-alive-p)
(gnus-registry-load)
- (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load)))
+ (add-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load)))
(defun gnus-registry-install-hooks ()
"Install the registry hooks."
(setq gnus-registry-enabled t)
- (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
- (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
- (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
- (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
+ (add-hook 'gnus-summary-article-move-hook #'gnus-registry-action)
+ (add-hook 'gnus-summary-article-delete-hook #'gnus-registry-action)
+ (add-hook 'gnus-summary-article-expire-hook #'gnus-registry-action)
+ (add-hook 'nnmail-spool-hook #'gnus-registry-spool-action)
- (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
+ (add-hook 'gnus-save-newsrc-hook #'gnus-registry-save)
- (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
+ (add-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids))
(defun gnus-registry-unload-hook ()
"Uninstall the registry hooks."
- (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
- (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
- (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
- (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
+ (remove-hook 'gnus-summary-article-move-hook #'gnus-registry-action)
+ (remove-hook 'gnus-summary-article-delete-hook #'gnus-registry-action)
+ (remove-hook 'gnus-summary-article-expire-hook #'gnus-registry-action)
+ (remove-hook 'nnmail-spool-hook #'gnus-registry-spool-action)
- (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
- (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load)
+ (remove-hook 'gnus-save-newsrc-hook #'gnus-registry-save)
+ (remove-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load)
- (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)
+ (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message-ids)
(setq gnus-registry-enabled nil))
-(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook)
+(add-hook 'gnus-registry-unload-hook #'gnus-registry-unload-hook)
(defun gnus-registry-install-p ()
"Return non-nil if the registry is enabled (and maybe enable it first).
@@ -1217,7 +1223,7 @@ is `ask', ask the user; or if `gnus-registry-install' is non-nil, enable it."
(gnus-registry-initialize)))
gnus-registry-enabled)
-;; largely based on nnir-warp-to-article
+;; largely based on nnselect-warp-to-article
(defun gnus-try-warping-via-registry ()
"Try to warp via the registry.
This will be done via the current article's source group based on
@@ -1234,14 +1240,14 @@ data stored in the registry."
(seen-groups (list (gnus-group-group-name))))
(catch 'found
- (dolist (group (mapcar 'gnus-simplify-group-name groups))
+ (dolist (group (mapcar #'gnus-simplify-group-name groups))
;; skip over any groups we really don't want to warp to.
(unless (or (member group seen-groups)
(gnus-ephemeral-group-p group) ;; any ephemeral group
(memq (car (gnus-find-method-for-group group))
;; Specific methods; this list may need to expand.
- '(nnir)))
+ '(nnselect)))
;; remember that we've seen this group already
(push group seen-groups)
@@ -1270,7 +1276,7 @@ EXTRA is a list of symbols. Valid symbols are those contained in
the docs of `gnus-registry-track-extra'. This command is useful
when you stop tracking some extra data and now want to purge it
from your existing entries."
- (interactive (list (mapcar 'intern
+ (interactive (list (mapcar #'intern
(completing-read-multiple
"Extra data: "
'("subject" "sender" "recipient")))))
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 46b70eaf275..2e3abe7832d 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -25,8 +25,6 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
(require 'gnus)
(require 'gnus-sum)
(require 'gnus-art)
@@ -35,6 +33,7 @@
(require 'message)
(require 'score-mode)
(require 'gmm-utils)
+(require 'cl-lib)
(defcustom gnus-global-score-files nil
"List of global score files and directories.
@@ -497,6 +496,7 @@ of the last successful match.")
("head" -1 gnus-score-body)
("body" -1 gnus-score-body)
("all" -1 gnus-score-body)
+ (score-fn -1 nil)
("followup" 2 gnus-score-followup)
("thread" 5 gnus-score-thread)))
@@ -862,6 +862,18 @@ If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
(setq match (string-to-number match)))
(set-text-properties 0 (length match) nil match))
+ ;; Modify match and type for article age scoring.
+ (if (string= "date" (nth 0 (assoc header gnus-header-index)))
+ (let ((age (string-to-number match)))
+ (if (or (< age 0)
+ (string= "0" match))
+ (user-error "Article age must be a positive number"))
+ (setq match age
+ type (cond ((eq type 'after)
+ '<)
+ ((eq type 'before)
+ '>)))))
+
(unless (eq date 'now)
;; Add the score entry to the score file.
(when (= score gnus-score-interactive-default-score)
@@ -1163,14 +1175,19 @@ If FORMAT, also format the current score file."
(when format
(gnus-score-pretty-print))
(when (consp rule) ;; the rule exists
- (setq rule (mapconcat #'(lambda (obj)
- (regexp-quote (format "%S" obj)))
- rule
- sep))
+ (setq rule (if (symbolp (car rule))
+ (format "(%S)" (car rule))
+ (mapconcat #'(lambda (obj)
+ (regexp-quote (format "%S" obj)))
+ rule
+ sep)))
(goto-char (point-min))
- (re-search-forward rule nil t)
- ;; make it easy to use `kill-sexp':
- (goto-char (1- (match-beginning 0)))))))
+ (let ((move (if (string-match "(.*)" rule)
+ 0
+ -1)))
+ (re-search-forward rule nil t)
+ ;; make it easy to use `kill-sexp':
+ (goto-char (+ move (match-beginning 0))))))))
(defun gnus-score-load-file (file)
;; Load score file FILE. Returns a list a retrieved score-alists.
@@ -1220,6 +1237,7 @@ If FORMAT, also format the current score file."
(let ((mark (car (gnus-score-get 'mark alist)))
(expunge (car (gnus-score-get 'expunge alist)))
(mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
+ (score-fn (car (gnus-score-get 'score-fn alist)))
(files (gnus-score-get 'files alist))
(exclude-files (gnus-score-get 'exclude-files alist))
(orphan (car (gnus-score-get 'orphan alist)))
@@ -1370,9 +1388,12 @@ If FORMAT, also format the current score file."
(setq
err
(cond
- ((if (member (downcase type) '("lines" "chars"))
- (not (numberp (car s)))
- (not (stringp (car s))))
+ ((cond ((member (downcase type) '("lines" "chars"))
+ (not (numberp (car s))))
+ ((string= (downcase type) "date")
+ (not (or (numberp (car s))
+ (stringp (car s)))))
+ (t (not (stringp (car s)))))
(format "Invalid match %s in %s" (car s) file))
((and (cadr s) (not (integerp (cadr s))))
(format "Non-integer score %s in %s" (cadr s) file))
@@ -1552,10 +1573,14 @@ If FORMAT, also format the current score file."
(gnus-message
7 "Scoring on headers or body skipped.")
nil)
+ ;; Run score-fn
+ (if (eq header 'score-fn)
+ (setq new (gnus-score-func scores trace))
;; Call the scoring function for this type of "header".
(setq new (funcall (nth 2 entry) scores header
- now expire trace)))
+ now expire trace))))
(push new news))))
+
(when (gnus-buffer-live-p gnus-summary-buffer)
(let ((scored gnus-newsgroup-scored))
(with-current-buffer gnus-summary-buffer
@@ -1621,6 +1646,30 @@ score in `gnus-newsgroup-scored' by SCORE."
(not (string= id "")))
(gnus-score-lower-thread thread score)))))
+(defun gnus-score-func (scores &optional trace)
+ (dolist (alist scores)
+ (let ((articles gnus-scores-articles)
+ (entries (assoc 'score-fn alist)))
+ (dolist (score-fn (cdr entries))
+ (let ((score-fn (car score-fn))
+ article-alist score fn-score)
+ (dolist (art articles)
+ (setq article-alist
+ (cl-pairlis
+ '(number subject from date id
+ refs chars lines xref extra)
+ (car art))
+ score (cdr art))
+ (when (integerp (setq fn-score (funcall score-fn
+ article-alist score)))
+ (setcdr art (+ score fn-score)))
+ (setq score (cdr art))
+ (when (and trace
+ (integerp fn-score))
+ (push (cons (car-safe (rassq alist gnus-score-cache))
+ (list score-fn fn-score))
+ gnus-score-trace))))))))
+
(defun gnus-score-integer (scores header now expire &optional trace)
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
entries alist)
@@ -1690,9 +1739,21 @@ score in `gnus-newsgroup-scored' by SCORE."
((eq type 'after)
(setq match-func 'string<
match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type '<)
+ (setq type 'after
+ match-func 'string<
+ match (gnus-time-iso8601
+ (time-subtract (current-time)
+ (* 86400 (nth 0 kill))))))
((eq type 'before)
(setq match-func 'gnus-string>
match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type '>)
+ (setq type 'before
+ match-func 'gnus-string>
+ match (gnus-time-iso8601
+ (time-subtract (current-time)
+ (* 86400 (nth 0 kill))))))
((eq type 'at)
(setq match-func 'string=
match (gnus-date-iso8601 (nth 0 kill))))
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
new file mode 100644
index 00000000000..498da200dab
--- /dev/null
+++ b/lisp/gnus/gnus-search.el
@@ -0,0 +1,2158 @@
+;;; gnus-search.el --- Search facilities for Gnus -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file defines a generalized search language, and search engines
+;; that interface with various search programs. It is responsible for
+;; parsing the user's search input, sending that query to the search
+;; engines, and collecting results. Results are in the form of a
+;; vector of vectors, each vector representing a found article. The
+;; nnselect backend interprets that value to create a group containing
+;; the search results.
+
+;; This file was formerly known as nnir. Later, the backend parts of
+;; nnir became nnselect, and only the search functionality was left
+;; here.
+
+;; See the Gnus manual for details of the search language. Tests are
+;; in tests/gnus-search-test.el.
+
+;; The search parsing routines are responsible for accepting the
+;; user's search query as a string and parsing it into a sexp
+;; structure. The function `gnus-search-parse-query' is the entry
+;; point for that. Once the query is in sexp form, it is passed to
+;; the search engines themselves, which are responsible for
+;; transforming the query into a form that the external program can
+;; understand, and then filtering the search results into a format
+;; that nnselect can understand.
+
+;; The general flow is:
+
+;; 1. The user calls one of `gnus-group-make-search-group' or
+;; `gnus-group-make-permanent-search-group' (or a few other entry
+;; points). These functions prompt for a search query, and collect
+;; the groups to search, then create an nnselect group, setting an
+;; 'nnselect-specs group parameter where 'nnselect-function is
+;; `gnus-search-run-query', and 'nnselect-args is the search query and
+;; groups to search.
+
+;; 2. `gnus-search-run-query' is called with 'nnselect-args. It looks
+;; at the groups to search, categorizes them by server, and for each
+;; server finds the search engine to use. It calls each engine's
+;; `gnus-search-run-search' method with the query and groups passed as
+;; arguments, and the results are collected and handed off to the
+;; nnselect group.
+
+;; For information on writing new search engines, see the Gnus manual.
+
+;; TODO: Rewrite the query parser using syntax tables and
+;; `parse-partial-sexp'.
+
+;; TODO: Refactor IMAP search so we can move code that uses nnimap-*
+;; functions out into nnimap.el.
+
+;; TODO: Is there anything we can do about sorting results?
+
+;; TODO: Provide for returning a result count. This would probably
+;; need a completely separate top-level command, since we wouldn't be
+;; creating a group at all.
+
+;;; Code:
+
+(require 'gnus-group)
+(require 'gnus-sum)
+(require 'message)
+(require 'gnus-util)
+(require 'eieio)
+(eval-when-compile (require 'cl-lib))
+(autoload 'eieio-build-class-alist "eieio-opt")
+(autoload 'nnmaildir-base-name-to-article-number "nnmaildir")
+
+(defvar gnus-inhibit-demon)
+(defvar gnus-english-month-names)
+
+;;; Internal Variables:
+
+;; When Gnus servers are implemented as objects or structs, give them
+;; a `search-engine' slot and get rid of this variable.
+(defvar gnus-search-engine-instance-alist nil
+ "Mapping between servers and instantiated search engines.")
+
+(defvar gnus-search-history ()
+ "Internal history of Gnus searches.")
+
+(defun gnus-search-shutdown ()
+ (setq gnus-search-engine-instance-alist nil))
+
+(gnus-add-shutdown #'gnus-search-shutdown 'gnus)
+
+(define-error 'gnus-search-parse-error "Gnus search parsing error")
+
+;;; User Customizable Variables:
+
+(defgroup gnus-search nil
+ "Search groups in Gnus with assorted search engines."
+ :group 'gnus)
+
+(defcustom gnus-search-use-parsed-queries nil
+ "When t, use Gnus' generalized search language.
+The generalized search language is a search language that can be
+used across all search engines that Gnus supports. See the Gnus
+manual for details.
+
+If this option is set to nil, search queries will be passed
+directly to the search engines without being parsed or
+transformed."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+(define-obsolete-variable-alias 'nnir-ignored-newsgroups
+ 'gnus-search-ignored-newsgroups "28.1")
+
+(defcustom gnus-search-ignored-newsgroups ""
+ "A regexp to match newsgroups in the active file that should
+ be skipped when searching."
+ :version "24.1"
+ :type 'regexp
+ :group 'gnus-search)
+
+(make-obsolete-variable
+ 'nnir-imap-default-search-key
+ "specify imap search keys, or use parsed queries." "28.1")
+
+;; Engine-specific configuration options.
+
+(defcustom gnus-search-swish++-config-file
+ (expand-file-name "~/Mail/swish++.conf")
+ "Location of Swish++ configuration file.
+This variable can also be set per-server."
+ :type 'file
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-program "search"
+ "Name of swish++ search executable.
+This variable can also be set per-server."
+ :type 'string
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-switches '()
+ "A list of strings, to be given as additional arguments to swish++.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-swish++-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-swish++-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by swish++
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-raw-queries-p nil
+ "If t, all Swish++ engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-config-file
+ (expand-file-name "~/Mail/swish-e.conf")
+ "Configuration file for swish-e.
+This variable can also be set per-server."
+ :type 'file
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-program "search"
+ "Name of swish-e search executable.
+This variable can also be set per-server."
+ :type 'string
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-switches '()
+ "A list of strings, to be given as additional arguments to swish-e.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-swish-e-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-swish-e-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by swish-e
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-index-files '()
+ "A list of index files to use with this Swish-e instance.
+This variable can also be set per-server."
+ :type '(repeat file)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-raw-queries-p nil
+ "If t, all Swish-e engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+;; Namazu engine, see <URL:http://www.namazu.org/>
+
+(defcustom gnus-search-namazu-program "namazu"
+ "Name of Namazu search executable.
+This variable can also be set per-server."
+ :type 'string
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-index-directory (expand-file-name "~/Mail/namazu/")
+ "Index directory for Namazu.
+This variable can also be set per-server."
+ :type 'directory
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-switches '()
+ "A list of strings, to be given as additional arguments to namazu.
+The switches `-q', `-a', and `-s' are always used, very few other switches
+make any sense in this context.
+
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-namazu-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-namazu-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by Namazu
+in order to get a group name (albeit with / instead of .).
+
+For example, suppose that Namazu returns file names such as
+\"/home/john/Mail/mail/misc/42\". For this example, use the following
+setting: (setq gnus-search-namazu-remove-prefix \"/home/john/Mail/\")
+Note the trailing slash. Removing this prefix gives \"mail/misc/42\".
+Gnus knows to remove the \"/42\" and to replace \"/\" with \".\" to
+arrive at the correct group name, \"mail.misc\".
+
+This variable can also be set per-server."
+ :type 'directory
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-raw-queries-p nil
+ "If t, all Namazu engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-program "notmuch"
+ "Name of notmuch search executable.
+This variable can also be set per-server."
+ :type '(string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-config-file
+ (expand-file-name "~/.notmuch-config")
+ "Configuration file for notmuch.
+This variable can also be set per-server."
+ :type 'file
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-switches '()
+ "A list of strings, to be given as additional arguments to notmuch.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-notmuch-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-notmuch-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by notmuch
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-raw-queries-p nil
+ "If t, all Notmuch engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-imap-raw-queries-p nil
+ "If t, all IMAP engines will only accept raw search query
+ strings."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-program "mairix"
+ "Name of mairix search executable.
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-config-file
+ (expand-file-name "~/.mairixrc")
+ "Configuration file for mairix.
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'file
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-switches '()
+ "A list of strings, to be given as additional arguments to mairix.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-mairix-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnu-search-mairix-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :version "28.1"
+ :type '(repeat string)
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by mairix
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'regexp
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-raw-queries-p nil
+ "If t, all Mairix engines will only accept raw search query
+ strings."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+;; Options for search language parsing.
+
+(defcustom gnus-search-expandable-keys
+ '("from" "subject" "to" "cc" "bcc" "body" "recipient" "date"
+ "mark" "before" "after" "larger" "smaller" "attachment" "text"
+ "since" "thread" "sender" "address" "tag" "size" "grep" "limit"
+ "raw" "message-id" "id")
+ "A list of strings representing expandable search keys.
+\"Expandable\" simply means the key can be abbreviated while
+typing in search queries, ie \"subject\" could be entered as
+\"subj\" or even \"su\", though \"s\" is ambigous between
+\"subject\" and \"since\".
+
+Ambiguous abbreviations will raise an error."
+ :group 'gnus-search
+ :version "28.1"
+ :type '(repeat string))
+
+(defcustom gnus-search-date-keys
+ '("date" "before" "after" "on" "senton" "sentbefore" "sentsince" "since")
+ "A list of keywords whose value should be parsed as a date.
+See the docstring of `gnus-search-parse-query' for information on
+date parsing."
+ :group 'gnus-search
+ :version "26.1"
+ :type '(repeat string))
+
+(defcustom gnus-search-contact-tables '()
+ "A list of completion tables used to search for messages from contacts.
+Each list element should be a table or collection suitable to be
+returned by `completion-at-point-functions'. That usually means
+a list of strings, a hash table, or an alist."
+ :group 'gnus-search
+ :version "28.1"
+ :type '(repeat sexp))
+
+;;; Search language
+
+;; This "language" was generalized from the original IMAP search query
+;; parsing routine.
+
+(defun gnus-search-parse-query (string)
+ "Turn STRING into an s-expression based query.
+The resulting query structure is passed to the various search
+backends, each of which adapts it as needed.
+
+The search \"language\" is essentially a series of key:value
+expressions. Key is most often a mail header, but there are
+other keys. Value is a string, quoted if it contains spaces.
+Key and value are separated by a colon, no space. Expressions
+are implictly ANDed; the \"or\" keyword can be used to
+OR. \"not\" will negate the following expression, or keys can be
+prefixed with a \"-\". The \"near\" operator will work for
+engines that understand it; other engines will convert it to
+\"or\". Parenthetical groups work as expected.
+
+A key that matches the name of a mail header will search that
+header.
+
+Search keys can be expanded with TAB during entry, or left
+abbreviated so long as they remain unambiguous, ie \"f\" will
+search the \"from\" header. \"s\" will raise an error.
+
+Other keys:
+
+\"address\" will search all sender and recipient headers.
+
+\"recipient\" will search \"To\", \"Cc\", and \"Bcc\".
+
+\"before\" will search messages sent before the specified
+date (date specifications to come later). Date is exclusive.
+
+\"after\" (or its synonym \"since\") will search messages sent
+after the specified date. Date is inclusive.
+
+\"mark\" will search messages that have some sort of mark.
+Likely values include \"flag\", \"seen\", \"read\", \"replied\".
+It's also possible to use Gnus' internal marks, ie \"mark:R\"
+will be interpreted as mark:read.
+
+\"tag\" will search tags -- right now that's translated to
+\"keyword\" in IMAP, and left as \"tag\" for notmuch. At some
+point this should also be used to search marks in the Gnus
+registry.
+
+Other keys can be specified, provided that the search backends
+know how to interpret them.
+
+External contact-management packages can push completion tables
+onto the list variable `gnus-search-contact-tables', to provide
+auto-completion of contact names and addresses for keys like
+\"from\" and \"to\".
+
+Date values (any key in `gnus-search-date-keys') can be provided
+in any format that `parse-time-string' can parse (note that this
+can produce weird results). Dates with missing bits will be
+interpreted as the most recent occurance thereof (ie \"march 03\"
+is the most recent March 3rd). Lastly, relative specifications
+such as 1d (one day ago) are understood. This also accepts w, m,
+and y. m is assumed to be 30 days.
+
+This function will accept pretty much anything as input. Its
+only job is to parse the query into a sexp, and pass that on --
+it is the job of the search backends to make sense of the
+structured query. Malformed, unusable or invalid queries will
+typically be silently ignored."
+ (with-temp-buffer
+ ;; Set up the parsing environment.
+ (insert string)
+ (goto-char (point-min))
+ ;; Now, collect the output terms and return them.
+ (let (out)
+ (while (not (gnus-search-query-end-of-input))
+ (push (gnus-search-query-next-expr) out))
+ (reverse out))))
+
+(defun gnus-search-query-next-expr (&optional count halt)
+ "Return the next expression from the current buffer."
+ (let ((term (gnus-search-query-next-term count))
+ (next (gnus-search-query-peek-symbol)))
+ ;; Deal with top-level expressions. And, or, not, near... What
+ ;; else? Notmuch also provides xor and adj. It also provides a
+ ;; "nearness" parameter for near and adj.
+ (cond
+ ;; Handle 'expr or expr'
+ ((and (eq next 'or)
+ (null halt))
+ (list 'or term (gnus-search-query-next-expr 2)))
+ ;; Handle 'near operator.
+ ((eq next 'near)
+ (let ((near-next (gnus-search-query-next-expr 2)))
+ (if (and (stringp term)
+ (stringp near-next))
+ (list 'near term near-next)
+ (signal 'gnus-search-parse-error
+ (list "\"Near\" keyword must appear between two plain strings.")))))
+ ;; Anything else
+ (t term))))
+
+(defun gnus-search-query-next-term (&optional count)
+ "Return the next TERM from the current buffer."
+ (let ((term (gnus-search-query-next-symbol count)))
+ ;; What sort of term is this?
+ (cond
+ ;; negated term
+ ((eq term 'not) (list 'not (gnus-search-query-next-expr nil 'halt)))
+ ;; generic term
+ (t term))))
+
+(defun gnus-search-query-peek-symbol ()
+ "Return the next symbol from the current buffer, but don't consume it."
+ (save-excursion
+ (gnus-search-query-next-symbol)))
+
+(defun gnus-search-query-next-symbol (&optional count)
+ "Return the next symbol from the current buffer, or nil if we are
+at the end of the buffer. If supplied COUNT skips some symbols before
+returning the one at the supplied position."
+ (when (and (numberp count) (> count 1))
+ (gnus-search-query-next-symbol (1- count)))
+ (let ((case-fold-search t))
+ ;; end of input stream?
+ (unless (gnus-search-query-end-of-input)
+ ;; No, return the next symbol from the stream.
+ (cond
+ ;; Negated expression -- return it and advance one char.
+ ((looking-at "-") (forward-char 1) 'not)
+ ;; List expression -- we parse the content and return this as a list.
+ ((looking-at "(")
+ (gnus-search-parse-query (gnus-search-query-return-string ")" t)))
+ ;; Keyword input -- return a symbol version.
+ ((looking-at "\\band\\b") (forward-char 3) 'and)
+ ((looking-at "\\bor\\b") (forward-char 2) 'or)
+ ((looking-at "\\bnot\\b") (forward-char 3) 'not)
+ ((looking-at "\\bnear\\b") (forward-char 4) 'near)
+ ;; Plain string, no keyword
+ ((looking-at "[\"/]?\\b[^:]+\\([[:blank:]]\\|\\'\\)")
+ (gnus-search-query-return-string
+ (when (looking-at-p "[\"/]") t)))
+ ;; Assume a K:V expression.
+ (t (let ((key (gnus-search-query-expand-key
+ (buffer-substring
+ (point)
+ (progn
+ (re-search-forward ":" (point-at-eol) t)
+ (1- (point))))))
+ (value (gnus-search-query-return-string
+ (when (looking-at-p "[\"/]") t))))
+ (gnus-search-query-parse-kv key value)))))))
+
+(defun gnus-search-query-parse-kv (key value)
+ "Handle KEY and VALUE, parsing and expanding as necessary.
+This may result in (key value) being turned into a larger query
+structure.
+
+In the simplest case, they are simply consed together. String
+KEY is converted to a symbol."
+ (let (return)
+ (cond
+ ((member key gnus-search-date-keys)
+ (when (string= "after" key)
+ (setq key "since"))
+ (setq value (gnus-search-query-parse-date value)))
+ ((equal key "mark")
+ (setq value (gnus-search-query-parse-mark value)))
+ ((string= "message-id" key)
+ (setq key "id")))
+ (or return
+ (cons (intern key) value))))
+
+(defun gnus-search-query-parse-date (value &optional rel-date)
+ "Interpret VALUE as a date specification.
+See the docstring of `gnus-search-parse-query' for details.
+
+The result is a list of (dd mm yyyy); individual elements can be
+nil.
+
+If VALUE is a relative time, interpret it as relative to
+REL-DATE, or (current-time) if REL-DATE is nil."
+ ;; Time parsing doesn't seem to work with slashes.
+ (let ((value (replace-regexp-in-string "/" "-" value))
+ (now (append '(0 0 0)
+ (seq-subseq (decode-time (or rel-date
+ (current-time)))
+ 3))))
+ ;; Check for relative time parsing.
+ (if (string-match "\\([[:digit:]]+\\)\\([dwmy]\\)" value)
+ (seq-subseq
+ (decode-time
+ (time-subtract
+ (apply #'encode-time now)
+ (days-to-time
+ (* (string-to-number (match-string 1 value))
+ (cdr (assoc (match-string 2 value)
+ '(("d" . 1)
+ ("w" . 7)
+ ("m" . 30)
+ ("y" . 365))))))))
+ 3 6)
+ ;; Otherwise check the value of `parse-time-string'.
+
+ ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
+ (let ((d-time (parse-time-string value)))
+ ;; Did parsing produce anything at all?
+ (if (seq-some #'integerp (seq-subseq d-time 3 7))
+ (seq-subseq
+ ;; If DOW is given, handle that specially.
+ (if (and (seq-elt d-time 6) (null (seq-elt d-time 3)))
+ (decode-time
+ (time-subtract (apply #'encode-time now)
+ (days-to-time
+ (+ (if (> (seq-elt d-time 6)
+ (seq-elt now 6))
+ 7 0)
+ (- (seq-elt now 6) (seq-elt d-time 6))))))
+ d-time)
+ 3 6)
+ ;; `parse-time-string' failed to produce anything, just
+ ;; return the string.
+ value)))))
+
+(defun gnus-search-query-parse-mark (mark)
+ "Possibly transform MARK.
+If MARK is a single character, assume it is one of the
+gnus-*-mark marks, and return an appropriate string."
+ (if (= 1 (length mark))
+ (let ((m (aref mark 0)))
+ ;; Neither pcase nor cl-case will work here.
+ (cond
+ ((eql m gnus-ticked-mark) "flag")
+ ((eql m gnus-read-mark) "read")
+ ((eql m gnus-replied-mark) "replied")
+ ((eql m gnus-recent-mark) "recent")
+ (t mark)))
+ mark))
+
+(defun gnus-search-query-expand-key (key)
+ (cond ((test-completion key gnus-search-expandable-keys)
+ ;; We're done!
+ key)
+ ;; There is more than one possible completion.
+ ((consp (cdr (completion-all-completions
+ key gnus-search-expandable-keys #'stringp 0)))
+ (signal 'gnus-search-parse-error
+ (list (format "Ambiguous keyword: %s" key))))
+ ;; Return KEY, either completed or untouched.
+ ((car-safe (completion-try-completion
+ key gnus-search-expandable-keys
+ #'stringp 0)))))
+
+(defun gnus-search-query-return-string (&optional delimited trim)
+ "Return a string from the current buffer.
+If DELIMITED is non-nil, assume the next character is a delimiter
+character, and return everything between point and the next
+occurance of the delimiter, including the delimiters themselves.
+If TRIM is non-nil, do not return the delimiters. Otherwise,
+return one word."
+ ;; This function cannot handle nested delimiters, as it's not a
+ ;; proper parser. Ie, you cannot parse "to:bob or (from:bob or
+ ;; (cc:bob or bcc:bob))".
+ (let ((start (point))
+ (delimiter (if (stringp delimited)
+ delimited
+ (when delimited
+ (char-to-string (char-after)))))
+ end)
+ (if delimiter
+ (progn
+ (when trim
+ ;; Skip past first delimiter if we're trimming.
+ (forward-char 1))
+ (while (not end)
+ (unless (search-forward delimiter nil t (unless trim 2))
+ (signal 'gnus-search-parse-error
+ (list (format "Unmatched delimited input with %s in query" delimiter))))
+ (let ((here (point)))
+ (unless (equal (buffer-substring (- here 2) (- here 1)) "\\")
+ (setq end (if trim (1- (point)) (point))
+ start (if trim (1+ start) start))))))
+ (setq end (progn (re-search-forward "\\([[:blank:]]+\\|$\\)" (point-max) t)
+ (match-beginning 0))))
+ (buffer-substring-no-properties start end)))
+
+(defun gnus-search-query-end-of-input ()
+ "Are we at the end of input?"
+ (skip-chars-forward "[:blank:]")
+ (looking-at "$"))
+
+;;; Search engines
+
+;; Search engines are implemented as classes. This is good for two
+;; things: encapsulating things like indexes and search prefixes, and
+;; transforming search queries.
+
+(defclass gnus-search-engine ()
+ ((raw-queries-p
+ :initarg :raw-queries-p
+ :initform nil
+ :type boolean
+ :custom boolean
+ :documentation
+ "When t, searches through this engine will never be parsed or
+ transformed, and must be entered \"raw\"."))
+ :abstract t
+ :documentation "Abstract base class for Gnus search engines.")
+
+(defclass gnus-search-grep ()
+ ((grep-program
+ :initarg :grep-program
+ :initform "grep"
+ :type string
+ :documentation "Grep executable to use for second-pass grep
+ searches.")
+ (grep-options
+ :initarg :grep-options
+ :initform nil
+ :type list
+ :documentation "Additional options, in the form of a list,
+ passed to the second-pass grep search, when present."))
+ :abstract t
+ :documentation "An abstract mixin class that can be added to
+ local-filesystem search engines, providing an additional grep:
+ search key. After the base engine returns a list of search
+ results (as local filenames), an external grep process is used
+ to further filter the results.")
+
+(cl-defgeneric gnus-search-grep-search (engine artlist criteria)
+ "Run a secondary grep search over a list of preliminary results.
+
+ARTLIST is a list of (filename score) pairs, produced by one of
+the other search engines. CRITERIA is a grep-specific search
+key. This method uses an external grep program to further filter
+the files in ARTLIST by that search key.")
+
+(cl-defmethod gnus-search-grep-search ((engine gnus-search-grep)
+ artlist criteria)
+ (with-slots (grep-program grep-options) engine
+ (if (executable-find grep-program)
+ ;; Don't catch errors -- allow them to propagate.
+ (let ((matched-files
+ (apply
+ #'process-lines
+ grep-program
+ `("-l" ,@grep-options
+ "-e" ,(shell-quote-argument criteria)
+ ,@(mapcar #'car artlist)))))
+ (seq-filter (lambda (a) (member (car a) matched-files))
+ artlist))
+ (nnheader-report 'search "invalid grep program: %s" grep-program))))
+
+(defclass gnus-search-process ()
+ ((proc-buffer
+ :initarg :proc-buffer
+ :type buffer
+ :documentation "A temporary buffer this engine uses for its
+ search process, and for munging its search results."))
+ :abstract t
+ :documentation
+ "A mixin class for engines that do their searching in a single
+ process launched for this purpose, which returns at the end of
+ the search. Subclass instances are safe to be run in
+ threads.")
+
+(cl-defmethod shared-initialize ((engine gnus-search-process)
+ slots)
+ (setq slots (plist-put slots :proc-buffer
+ (generate-new-buffer " *gnus-search-")))
+ (cl-call-next-method engine slots))
+
+(defclass gnus-search-imap (gnus-search-engine)
+ ((literal-plus
+ :initarg :literal-plus
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle literal+ searches? This slot
+ is set automatically by the imap server, and cannot be
+ set manually. Only the LITERAL+ capability is handled.")
+ (multisearch
+ :initarg :multisearch
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle the MULTISEARCH capability?
+ This slot is set automatically by the imap server, and cannot
+ be set manually. Currently unimplemented.")
+ (fuzzy
+ :initarg :fuzzy
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle the FUZZY search capability?
+ This slot is set automatically by the imap server, and cannot
+ be set manually. Currently only partially implemented.")
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-imap-raw-queries-p)))
+ :documentation
+ "The base IMAP search engine, using an IMAP server's search capabilites.
+This backend may be subclassed to handle particular IMAP servers'
+quirks.")
+
+(defclass gnus-search-find-grep (gnus-search-engine
+ gnus-search-process
+ gnus-search-grep)
+ nil)
+
+;;; The "indexed" search engine.
+
+;; These are engines that use an external program, with indexes kept
+;; on disk, to search messages usually kept in some local directory.
+;; They have several slots in common, for instance program name or
+;; configuration file. Many of the subclasses also allow
+;; distinguishing multiple databases or indexes. These slots can be
+;; set using a global default, or on a per-server basis.
+
+(defclass gnus-search-indexed (gnus-search-engine
+ gnus-search-process
+ gnus-search-grep)
+ ((program
+ :initarg :program
+ :type string
+ :documentation
+ "The executable used for indexing and searching.")
+ (config-file
+ :init-arg :config-file
+ :type string
+ :custom file
+ :documentation "Location of the config file, if any.")
+ (remove-prefix
+ :initarg :remove-prefix
+ :initform (concat (getenv "HOME") "/Mail/")
+ :type string
+ :documentation
+ "The path to the directory where the indexed mails are
+ kept. This path is removed from the search results.")
+ (switches
+ :initarg :switches
+ :type list
+ :documentation
+ "Additional switches passed to the search engine command-line
+ program."))
+ :abstract t
+ :allow-nil-initform t
+ :documentation "A base search engine class that assumes a local search index
+ accessed by a command line program.")
+
+(defclass gnus-search-swish-e (gnus-search-indexed)
+ ((index-files
+ :init-arg :index-files
+ :initform (symbol-value 'gnus-search-swish-e-index-files)
+ :type list)
+ (program
+ :initform (symbol-value 'gnus-search-swish-e-program))
+ (remove-prefix
+ :initform (symbol-value 'gnus-search-swish-e-remove-prefix))
+ (switches
+ :initform (symbol-value 'gnus-search-swish-e-switches))
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-swish-e-raw-queries-p))))
+
+(defclass gnus-search-swish++ (gnus-search-indexed)
+ ((program
+ :initform (symbol-value 'gnus-search-swish++-program))
+ (remove-prefix
+ :initform (symbol-value 'gnus-search-swish++-remove-prefix))
+ (switches
+ :initform (symbol-value 'gnus-search-swish++-switches))
+ (config-file
+ :initform (symbol-value 'gnus-search-swish++-config-file))
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-swish++-raw-queries-p))))
+
+(defclass gnus-search-mairix (gnus-search-indexed)
+ ((program
+ :initform (symbol-value 'gnus-search-mairix-program))
+ (remove-prefix
+ :initform (symbol-value 'gnus-search-mairix-remove-prefix))
+ (switches
+ :initform (symbol-value 'gnus-search-mairix-switches))
+ (config-file
+ :initform (symbol-value 'gnus-search-mairix-config-file))
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-mairix-raw-queries-p))))
+
+(defclass gnus-search-namazu (gnus-search-indexed)
+ ((index-directory
+ :initarg :index-directory
+ :type string
+ :custom directory)
+ (program
+ :initform (symbol-value 'gnus-search-namazu-program))
+ (remove-prefix
+ :initform (symbol-value 'gnus-search-namazu-remove-prefix))
+ (switches
+ :initform (symbol-value 'gnus-search-namazu-switches))
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-namazu-raw-queries-p))))
+
+(defclass gnus-search-notmuch (gnus-search-indexed)
+ ((program
+ :initform (symbol-value 'gnus-search-notmuch-program))
+ (remove-prefix
+ :initform (symbol-value 'gnus-search-notmuch-remove-prefix))
+ (switches
+ :initform (symbol-value 'gnus-search-notmuch-switches))
+ (config-file
+ :initform (symbol-value 'gnus-search-notmuch-config-file))
+ (raw-queries-p
+ :initform (symbol-value 'gnus-search-notmuch-raw-queries-p))))
+
+(define-obsolete-variable-alias 'nnir-method-default-engines
+ 'gnus-search-default-engines "28.1")
+
+(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap))
+ "Alist of default search engines keyed by server method."
+ :version "26.1"
+ :group 'gnus-search
+ :type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool)
+ (const nneething) (const nndir) (const nnmbox)
+ (const nnml) (const nnmh) (const nndraft)
+ (const nnfolder) (const nnmaildir))
+ (choice
+ ,@(mapcar
+ (lambda (el) (list 'const (intern (car el))))
+ (eieio-build-class-alist 'gnus-search-engine t))))))
+
+;;; Transforming and running search queries.
+
+(cl-defgeneric gnus-search-run-search (engine server query groups)
+ "Run QUERY in GROUPS against SERVER, using search ENGINE.
+Should return results as a vector of vectors.")
+
+(cl-defgeneric gnus-search-transform (engine expression)
+ "Transform sexp EXPRESSION into a string search query usable by ENGINE.
+Responsible for handling and, or, and parenthetical expressions.")
+
+(cl-defgeneric gnus-search-transform-expression (engine expression)
+ "Transform a basic EXPRESSION into a string usable by ENGINE.")
+
+(cl-defgeneric gnus-search-make-query-string (engine query-spec)
+ "Extract the actual query string to use from QUERY-SPEC.")
+
+;; Methods that are likely to be the same for all engines.
+
+(cl-defmethod gnus-search-make-query-string ((engine gnus-search-engine)
+ query-spec)
+ (let ((parsed-query (alist-get 'parsed-query query-spec))
+ (raw-query (alist-get 'query query-spec)))
+ (if (and gnus-search-use-parsed-queries
+ (null (alist-get 'raw query-spec))
+ (null (slot-value engine 'raw-queries-p))
+ parsed-query)
+ (gnus-search-transform engine parsed-query)
+ (if (listp raw-query)
+ ;; Some callers are sending this in as (query "query"), not
+ ;; as a cons cell?
+ (car raw-query)
+ raw-query))))
+
+(defsubst gnus-search-single-p (query)
+ "Return t if QUERY is a search for a single message."
+ (let ((q (alist-get 'parsed-query query)))
+ (and (= (length q ) 1)
+ (consp (car-safe q))
+ (eq (caar q) 'id))))
+
+(cl-defmethod gnus-search-transform ((engine gnus-search-engine)
+ (query list))
+ (let (clauses)
+ (mapc
+ (lambda (item)
+ (when-let ((expr (gnus-search-transform-expression engine item)))
+ (push expr clauses)))
+ query)
+ (mapconcat #'identity (reverse clauses) " ")))
+
+;; Most search engines just pass through plain strings.
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
+ (expr string))
+ expr)
+
+;; Most search engines use implicit ANDs.
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
+ (_expr (eql and)))
+ nil)
+
+;; Most search engines use explicit infixed ORs.
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-engine)
+ (expr (head or)))
+ (let ((left (gnus-search-transform-expression engine (nth 1 expr)))
+ (right (gnus-search-transform-expression engine (nth 2 expr))))
+ ;; Unhandled keywords return a nil; don't create an "or" expression
+ ;; unless both sub-expressions are non-nil.
+ (if (and left right)
+ (format "%s or %s" left right)
+ (or left right))))
+
+;; Most search engines just use the string "not"
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-engine)
+ (expr (head not)))
+ (let ((next (gnus-search-transform-expression engine (cadr expr))))
+ (when next
+ (format "not %s" next))))
+
+;;; Search Engine Interfaces:
+
+(autoload 'nnimap-change-group "nnimap")
+(declare-function nnimap-buffer "nnimap" ())
+(declare-function nnimap-command "nnimap" (&rest args))
+
+;; imap interface
+(cl-defmethod gnus-search-run-search ((engine gnus-search-imap)
+ srv query groups)
+ (save-excursion
+ (let ((server (cadr (gnus-server-to-method srv)))
+ (gnus-inhibit-demon t)
+ ;; We're using the message id to look for a single message.
+ (single-search (gnus-search-single-p query))
+ (grouplist (or groups (gnus-search-get-active srv)))
+ q-string artlist group)
+ (message "Opening server %s" server)
+ ;; We should only be doing this once, in
+ ;; `nnimap-open-connection', but it's too frustrating to try to
+ ;; get to the server from the process buffer.
+ (with-current-buffer (nnimap-buffer)
+ (setf (slot-value engine 'literal-plus)
+ (when (nnimap-capability "LITERAL+") t))
+ ;; MULTISEARCH not yet implemented.
+ (setf (slot-value engine 'multisearch)
+ (when (nnimap-capability "MULTISEARCH") t))
+ ;; FUZZY only partially supported: the command is sent to the
+ ;; server (and presumably acted upon), but we don't yet
+ ;; request a RELEVANCY score as part of the response.
+ (setf (slot-value engine 'fuzzy)
+ (when (nnimap-capability "SEARCH=FUZZY") t)))
+
+ (setq q-string
+ (gnus-search-make-query-string engine query))
+
+ ;; If it's a thread query, make sure that all message-id
+ ;; searches are also references searches.
+ (when (alist-get 'thread query)
+ (setq q-string
+ (replace-regexp-in-string
+ "HEADER Message-Id \\([^ )]+\\)"
+ "(OR HEADER Message-Id \\1 HEADER References \\1)"
+ q-string)))
+
+ (while (and (setq group (pop grouplist))
+ (or (null single-search) (null artlist)))
+ (when (nnimap-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let ((result
+ (gnus-search-imap-search-command engine q-string)))
+ (when (car result)
+ (setq artlist
+ (vconcat
+ (mapcar
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (vector group artn 100))))
+ (cdr (assoc "SEARCH" (cdr result))))
+ artlist))))
+ (message "Searching %s...done" group))))
+ (nreverse artlist))))
+
+(cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap)
+ (query string))
+ "Create the IMAP search command for QUERY.
+Currenly takes into account support for the LITERAL+ capability.
+Other capabilities could be tested here."
+ (with-slots (literal-plus) engine
+ (when literal-plus
+ (setq query (split-string query "\n")))
+ (cond
+ ((consp query)
+ ;; We're not really streaming, just need to prevent
+ ;; `nnimap-send-command' from waiting for a response.
+ (let* ((nnimap-streaming t)
+ (call
+ (nnimap-send-command
+ "UID SEARCH CHARSET UTF-8 %s"
+ (pop query))))
+ (dolist (l query)
+ (process-send-string (get-buffer-process (current-buffer)) l)
+ (process-send-string (get-buffer-process (current-buffer))
+ (if (nnimap-newlinep nnimap-object)
+ "\n"
+ "\r\n")))
+ (nnimap-get-response call)))
+ (t (nnimap-command "UID SEARCH %s" query)))))
+
+;; TODO: Don't exclude booleans and date keys, just check for them
+;; before checking for general keywords.
+(defvar gnus-search-imap-search-keys
+ '(body cc bcc from header keyword larger smaller subject text to uid x-gm-raw)
+ "Known IMAP search keys, excluding booleans and date keys.")
+
+(cl-defmethod gnus-search-transform ((_ gnus-search-imap)
+ (_query null))
+ "ALL")
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr string))
+ (unless (string-match-p "\\`/.+/\\'" expr)
+ ;; Also need to check for fuzzy here. Or better, do some
+ ;; refactoring of this stuff.
+ (format "TEXT %s"
+ (gnus-search-imap-handle-string engine expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head or)))
+ (let ((left (gnus-search-transform-expression engine (nth 1 expr)))
+ (right (gnus-search-transform-expression engine (nth 2 expr))))
+ (if (and left right)
+ (format "(OR %s %s)"
+ left (format (if (eq 'or (car-safe (nth 2 expr)))
+ "(%s)" "%s")
+ right))
+ (or left right))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head near)))
+ "Imap searches interpret \"near\" as \"or\"."
+ (setcar expr 'or)
+ (gnus-search-transform-expression engine expr))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head not)))
+ "Transform IMAP NOT.
+If the term to be negated is a flag, then use the appropriate UN*
+boolean instead."
+ (if (eql (caadr expr) 'mark)
+ (if (string= (cdadr expr) "new")
+ "OLD"
+ (format "UN%s" (gnus-search-imap-handle-flag (cdadr expr))))
+ (format "NOT %s"
+ (gnus-search-transform-expression engine (cadr expr)))))
+
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-imap)
+ (expr (head mark)))
+ (gnus-search-imap-handle-flag (cdr expr)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr list))
+ "Handle a search keyword for IMAP.
+All IMAP search keywords that take a value are supported
+directly. Keywords that are boolean are supported through other
+means (usually the \"mark\" keyword)."
+ (let ((fuzzy-supported (slot-value engine 'fuzzy))
+ (fuzzy ""))
+ (cl-case (car expr)
+ (date (setcar expr 'on))
+ (tag (setcar expr 'keyword))
+ (sender (setcar expr 'from))
+ (attachment (setcar expr 'body)))
+ ;; Allow sizes specified as KB or MB.
+ (let ((case-fold-search t)
+ unit)
+ (when (and (memq (car expr) '(larger smaller))
+ (string-match "\\(kb?\\|mb?\\)\\'" (cdr expr)))
+ (setq unit (match-string 1 (cdr expr)))
+ (setcdr expr
+ (number-to-string
+ (* (string-to-number
+ (string-replace unit "" (cdr expr)))
+ (if (string-prefix-p "k" unit)
+ 1024
+ 1048576))))))
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eq (car expr) 'recipient)
+ (gnus-search-transform
+ engine (gnus-search-parse-query
+ (format
+ "to:%s or cc:%s or bcc:%s"
+ (cdr expr) (cdr expr) (cdr expr)))))
+ ((eq (car expr) 'address)
+ (gnus-search-transform
+ engine (gnus-search-parse-query
+ (format
+ "from:%s or to:%s or cc:%s or bcc:%s"
+ (cdr expr) (cdr expr) (cdr expr) (cdr expr)))))
+ ((memq (car expr) '(before since on sentbefore senton sentsince))
+ ;; Ignore dates given as strings.
+ (when (listp (cdr expr))
+ (format "%s %s"
+ (upcase (symbol-name (car expr)))
+ (gnus-search-imap-handle-date engine (cdr expr)))))
+ ((stringp (cdr expr))
+ ;; If the search term starts or ends with "*", remove the
+ ;; asterisk. If the engine supports FUZZY, then additionally make
+ ;; the search fuzzy.
+ (when (string-match "\\`\\*\\|\\*\\'" (cdr expr))
+ (setcdr expr (replace-regexp-in-string
+ "\\`\\*\\|\\*\\'" "" (cdr expr)))
+ (when fuzzy-supported
+ (setq fuzzy "FUZZY ")))
+ ;; If the search term is a regexp, drop the expression altogether.
+ (unless (string-match-p "\\`/.+/\\'" (cdr expr))
+ (cond
+ ((memq (car expr) gnus-search-imap-search-keys)
+ (format "%s%s %s"
+ fuzzy
+ (upcase (symbol-name (car expr)))
+ (gnus-search-imap-handle-string engine (cdr expr))))
+ ((eq (car expr) 'id)
+ (format "HEADER Message-ID \"%s\"" (cdr expr)))
+ ;; Treat what can't be handled as a HEADER search. Probably a bad
+ ;; idea.
+ (t (format "%sHEADER %s %s"
+ fuzzy
+ (car expr)
+ (gnus-search-imap-handle-string engine (cdr expr))))))))))
+
+(cl-defmethod gnus-search-imap-handle-date ((_engine gnus-search-imap)
+ (date list))
+ "Turn DATE into a date string recognizable by IMAP.
+While other search engines can interpret partially-qualified
+dates such as a plain \"January\", IMAP requires an absolute
+date.
+
+DATE is a list of (dd mm yyyy), any element of which could be
+nil. Massage those numbers into the most recent past occurrence
+of whichever date elements are present."
+ (let ((now (decode-time (current-time))))
+ ;; Set nil values to 1, current-month, current-year, or else 1, 1,
+ ;; current-year, depending on what we think the user meant.
+ (unless (seq-elt date 1)
+ (setf (seq-elt date 1)
+ (if (seq-elt date 0)
+ (seq-elt now 4)
+ 1)))
+ (unless (seq-elt date 0)
+ (setf (seq-elt date 0) 1))
+ (unless (seq-elt date 2)
+ (setf (seq-elt date 2)
+ (seq-elt now 5)))
+ ;; Fiddle with the date until it's in the past. There
+ ;; must be a way to combine all these steps.
+ (unless (< (seq-elt date 2)
+ (seq-elt now 5))
+ (when (< (seq-elt now 3)
+ (seq-elt date 0))
+ (cl-decf (seq-elt date 1)))
+ (cond ((zerop (seq-elt date 1))
+ (setf (seq-elt date 1) 1)
+ (cl-decf (seq-elt date 2)))
+ ((< (seq-elt now 4)
+ (seq-elt date 1))
+ (cl-decf (seq-elt date 2))))))
+ (format-time-string "%e-%b-%Y" (apply #'encode-time
+ (append '(0 0 0)
+ date))))
+
+(cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap)
+ (str string))
+ (with-slots (literal-plus) engine
+ (if (multibyte-string-p str)
+ ;; If LITERAL+ is available, use it and encode string as
+ ;; UTF-8.
+ (if literal-plus
+ (format "{%d+}\n%s"
+ (string-bytes str)
+ (encode-coding-string str 'utf-8))
+ ;; Otherwise, if the user hasn't already quoted the string,
+ ;; quote it for them.
+ (if (string-prefix-p "\"" str)
+ str
+ (format "\"%s\"" str)))
+ str)))
+
+(defun gnus-search-imap-handle-flag (flag)
+ "Make sure string FLAG is something IMAP will recognize."
+ ;; What else? What about the KEYWORD search key?
+ (setq flag
+ (pcase flag
+ ("flag" "flagged")
+ ("read" "seen")
+ (_ flag)))
+ (if (member flag '("seen" "answered" "deleted" "draft" "flagged"))
+ (upcase flag)
+ ""))
+
+;;; Methods for the indexed search engines.
+
+;; First, some common methods.
+
+(cl-defgeneric gnus-search-indexed-parse-output (engine server &optional groups)
+ "Parse the results of ENGINE's query against SERVER in GROUPS.
+Locally-indexed search engines return results as a list of
+filenames, sometimes with additional information. Returns a list
+of viable results, in the form of a list of [group article score]
+vectors.")
+
+(cl-defgeneric gnus-search-indexed-extract (engine)
+ "Extract a single article result from the current buffer.
+Returns a list of two values: a file name, and a relevancy score.
+Advances point to the beginning of the next result.")
+
+(cl-defmethod gnus-search-run-search ((engine gnus-search-indexed)
+ server query groups)
+ "Run QUERY against SERVER using ENGINE.
+This method is common to all indexed search engines.
+
+Returns a list of [group article score] vectors."
+
+ (save-excursion
+ (let* ((qstring (gnus-search-make-query-string engine query))
+ (program (slot-value engine 'program))
+ (buffer (slot-value engine 'proc-buffer))
+ (cp-list (gnus-search-indexed-search-command
+ engine qstring query groups))
+ proc exitstatus)
+ (set-buffer buffer)
+ (erase-buffer)
+
+ (if groups
+ (message "Doing %s query on %s..." program groups)
+ (message "Doing %s query..." program))
+ (setq proc (apply #'start-process (format "search-%s" server)
+ buffer program cp-list))
+ (while (process-live-p proc)
+ (accept-process-output proc))
+ (setq exitstatus (process-exit-status proc))
+ (if (zerop exitstatus)
+ ;; The search results have been put into the current buffer;
+ ;; `parse-output' finds them there and returns the article
+ ;; list.
+ (gnus-search-indexed-parse-output engine server query groups)
+ (nnheader-report 'search "%s error: %s" program exitstatus)
+ ;; Failure reason is in this buffer, show it if the user
+ ;; wants it.
+ (when (> gnus-verbose 6)
+ (display-buffer buffer))
+ nil))))
+
+(cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed)
+ server query &optional groups)
+ (let ((prefix (slot-value engine 'remove-prefix))
+ (group-regexp (when groups
+ (regexp-opt
+ (mapcar
+ (lambda (x) (gnus-group-real-name x))
+ groups))))
+ artlist vectors article group)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine)))
+ (when (and (file-readable-p f-name)
+ (null (file-directory-p f-name))
+ (or (null groups)
+ (and (gnus-search-single-p query)
+ (alist-get 'thread query))
+ (string-match-p group-regexp f-name)))
+ (push (list f-name score) artlist))))
+ ;; Are we running an additional grep query?
+ (when-let ((grep-reg (alist-get 'grep query)))
+ (setq artlist (gnus-search-grep-search engine artlist grep-reg)))
+ ;; Turn (file-name score) into [group article score].
+ (pcase-dolist (`(,f-name ,score) artlist)
+ (setq article (file-name-nondirectory f-name))
+ ;; Remove prefix.
+ (when (and prefix
+ (file-name-absolute-p prefix)
+ (string-match (concat "^"
+ (file-name-as-directory prefix))
+ f-name))
+ (setq group (replace-match "" t t (file-name-directory f-name))))
+ ;; Break the directory name down until it's something that
+ ;; (probably) can be used as a group name.
+ (setq group
+ (replace-regexp-in-string
+ "[/\\]" "."
+ (replace-regexp-in-string
+ "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
+ (replace-regexp-in-string
+ "^[./\\]" ""
+ group nil t)
+ nil t)
+ nil t))
+
+ (push (vector (gnus-group-full-name group server)
+ (if (string-match-p "\\`[[:digit:]]+\\'" article)
+ (string-to-number article)
+ (nnmaildir-base-name-to-article-number
+ (substring article 0 (string-match ":" article))
+ group nil))
+ (if (numberp score)
+ score
+ (string-to-number score)))
+ vectors))
+ vectors))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
+ "Base implementation treats the whole line as a filename, and
+fudges a relevancy score of 100."
+ (prog1
+ (list (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position))
+ 100)
+ (forward-line 1)))
+
+;; Swish++
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-swish++)
+ (expr (head near)))
+ (format "%s near %s"
+ (gnus-search-transform-expression engine (nth 1 expr))
+ (gnus-search-transform-expression engine (nth 2 expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-swish++)
+ (expr list))
+ (cond
+ ((listp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ;; Untested and likely wrong.
+ ((and (stringp (cdr expr))
+ (string-prefix-p "(" (cdr expr)))
+ (format "%s = %s" (car expr) (gnus-search-transform
+ engine
+ (gnus-search-parse-query (cdr expr)))))
+ (t (format "%s = %s" (car expr) (cdr expr)))))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-swish++)
+ (qstring string)
+ _query &optional _groups)
+ (with-slots (config-file switches) engine
+ `("--config-file" ,config-file
+ ,@switches
+ ,qstring
+ )))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-swish++))
+ (when (re-search-forward
+ "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t)
+ (list (match-string 2)
+ (match-string 1))))
+
+;; Swish-e
+
+;; I didn't do the query transformation for Swish-e, because the
+;; program seems no longer to exist.
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-swish-e)
+ (qstring string)
+ _query &optional _groups)
+ (with-slots (index-files switches) engine
+ `("-f" ,@index-files
+ ,@switches
+ "-w"
+ ,qstring
+ )))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-swish-e))
+ (when (re-search-forward
+ "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t)
+ (list (match-string 3)
+ (match-string 1))))
+
+;; Namazu interface
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-namazu)
+ (expr list))
+ (cond
+ ((listp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eql (car expr) 'body)
+ (cadr expr))
+ ;; I have no idea which fields namazu can handle. Just do these
+ ;; for now.
+ ((memq (car expr) '(subject from to))
+ (format "+%s:%s" (car expr) (cdr expr)))
+ ((eql (car expr) 'address)
+ (gnus-search-transform engine `((or (from . ,(cdr expr))
+ (to . ,(cdr expr))))))
+ ((eq (car expr) 'id)
+ (format "+message-id:%s" (cdr expr)))
+ (t (ignore-errors (cl-call-next-method)))))
+
+;; I can't tell if this is actually necessary.
+(cl-defmethod gnus-search-run-search :around ((_e gnus-search-namazu)
+ _server _query _groups)
+ (let ((process-environment (copy-sequence process-environment)))
+ (setenv "LC_MESSAGES" "C")
+ (cl-call-next-method)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-namazu)
+ (qstring string)
+ query &optional _groups)
+ (let ((max (alist-get 'limit query)))
+ (with-slots (switches index-directory) engine
+ (append
+ (list "-q" ; don't be verbose
+ "-a" ; show all matches
+ "-s") ; use short format
+ (when max (list (format "--max=%d" max)))
+ switches
+ (list qstring index-directory)))))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-namazu))
+ "Extract a single message result for Namazu.
+Namazu provides a little more information, for instance a score."
+
+ (when (re-search-forward
+ "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
+ nil t)
+ (list (match-string 4)
+ (match-string 3))))
+
+;;; Notmuch interface
+
+(cl-defmethod gnus-search-transform ((_engine gnus-search-notmuch)
+ (_query null))
+ "*")
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch)
+ (expr (head near)))
+ (format "%s near %s"
+ (gnus-search-transform-expression engine (nth 1 expr))
+ (gnus-search-transform-expression engine (nth 2 expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch)
+ (expr list))
+ ;; Swap keywords as necessary.
+ (cl-case (car expr)
+ (sender (setcar expr 'from))
+ ;; Notmuch's "to" is already equivalent to our "recipient".
+ (recipient (setcar expr 'to))
+ (mark (setcar expr 'tag)))
+ ;; Then actually format the results.
+ (cl-flet ((notmuch-date (date)
+ (if (stringp date)
+ date
+ (pcase date
+ (`(nil ,m nil)
+ (nth (1- m) gnus-english-month-names))
+ (`(nil nil ,y)
+ (number-to-string y))
+ (`(,d ,m nil)
+ (format "%02d-%02d" d m))
+ (`(nil ,m ,y)
+ (format "%02d-%d" m y))
+ (`(,d ,m ,y)
+ (format "%d/%d/%d" m d y))))))
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eql (car expr) 'address)
+ (gnus-search-transform engine `((or (from . ,(cdr expr))
+ (to . ,(cdr expr))))))
+ ((eql (car expr) 'body)
+ (cdr expr))
+ ((memq (car expr) '(from to subject attachment mimetype tag id
+ thread folder path lastmod query property))
+ ;; Notmuch requires message-id with no angle brackets.
+ (when (eql (car expr) 'id)
+ (setcdr
+ expr (replace-regexp-in-string "\\`<\\|>\\'" "" (cdr expr))))
+ (format "%s:%s" (car expr)
+ (if (string-match "\\`\\*" (cdr expr))
+ ;; Notmuch can only handle trailing asterisk
+ ;; wildcards, so strip leading asterisks.
+ (replace-match "" nil nil (cdr expr))
+ (cdr expr))))
+ ((eq (car expr) 'date)
+ (format "date:%s" (notmuch-date (cdr expr))))
+ ((eq (car expr) 'before)
+ (format "date:..%s" (notmuch-date (cdr expr))))
+ ((eq (car expr) 'since)
+ (format "date:%s.." (notmuch-date (cdr expr))))
+ (t (ignore-errors (cl-call-next-method))))))
+
+(cl-defmethod gnus-search-run-search :around ((engine gnus-search-notmuch)
+ server query groups)
+ "Handle notmuch's thread-search routine."
+ ;; Notmuch allows for searching threads, but only using its own
+ ;; thread ids. That means a thread search is a \"double-bounce\":
+ ;; once to find the relevant thread ids, and again to find the
+ ;; actual messages. This method performs the first \"bounce\".
+ (if (alist-get 'thread query)
+ (with-slots (program proc-buffer) engine
+ (let* ((qstring
+ (gnus-search-make-query-string engine query))
+ (cp-list (gnus-search-indexed-search-command
+ engine qstring query groups))
+ thread-ids proc)
+ (set-buffer proc-buffer)
+ (erase-buffer)
+ (setq proc (apply #'start-process (format "search-%s" server)
+ proc-buffer program cp-list))
+ (while (process-live-p proc)
+ (accept-process-output proc))
+ (while (re-search-forward "^thread:\\([^ ]+\\)" (point-max) t)
+ (push (match-string 1) thread-ids))
+ (cl-call-next-method
+ engine server
+ ;; Completely replace the query with our new thread-based one.
+ (mapconcat (lambda (thrd) (concat "thread:" thrd))
+ thread-ids " or ")
+ nil)))
+ (cl-call-next-method engine server query groups)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-notmuch)
+ (qstring string)
+ query &optional _groups)
+ ;; Theoretically we could use the GROUPS parameter to pass a
+ ;; --folder switch to notmuch, but I'm not confident of getting the
+ ;; format right.
+ (let ((limit (alist-get 'limit query))
+ (thread (alist-get 'thread query)))
+ (with-slots (switches config-file) engine
+ `(,(format "--config=%s" config-file)
+ "search"
+ ,(if thread
+ "--output=threads"
+ "--output=files")
+ "--duplicate=1" ; I have found this necessary, I don't know why.
+ ,@switches
+ ,(if limit (format "--limit=%d" limit) "")
+ ,qstring
+ ))))
+
+;;; Mairix interface
+
+;; See the Gnus manual for why mairix searching is a bit weird.
+
+(cl-defmethod gnus-search-transform ((engine gnus-search-mairix)
+ (query list))
+ "Transform QUERY for a Mairix engine.
+Because Mairix doesn't accept parenthesized expressions, nor
+\"or\" statements between different keys, results may differ from
+other engines. We unpeel parenthesized expressions, and just
+cross our fingers for the rest of it."
+ (let (clauses)
+ (mapc
+ (lambda (item)
+ (when-let ((expr (if (consp (car-safe item))
+ (gnus-search-transform engine item)
+ (gnus-search-transform-expression engine item))))
+ (push expr clauses)))
+ query)
+ (mapconcat #'identity (reverse clauses) " ")))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr (head not)))
+ "Transform Mairix \"not\".
+Mairix negation requires a \"~\" preceding string search terms,
+and \"-\" before marks."
+ (let ((next (gnus-search-transform-expression engine (cadr expr))))
+ (replace-regexp-in-string
+ ":"
+ (if (eql (caadr expr) 'mark)
+ ":-"
+ ":~")
+ next)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr (head or)))
+ "Handle Mairix \"or\" statement.
+Mairix only accepts \"or\" expressions on homogenous keys. We
+cast \"or\" expressions on heterogenous keys as \"and\", which
+isn't quite right, but it's the best we can do. For date keys,
+only keep one of the terms."
+ (let ((term1 (caadr expr))
+ (term2 (caaddr expr))
+ (val1 (gnus-search-transform-expression engine (nth 1 expr)))
+ (val2 (gnus-search-transform-expression engine (nth 2 expr))))
+ (cond
+ ((or (listp term1) (listp term2))
+ (concat val1 " " val2))
+ ((and (member (symbol-name term1) gnus-search-date-keys)
+ (member (symbol-name term2) gnus-search-date-keys))
+ (or val1 val2))
+ ((eql term1 term2)
+ (if (and val1 val2)
+ (format "%s/%s"
+ val1
+ (nth 1 (split-string val2 ":")))
+ (or val1 val2)))
+ (t (concat val1 " " val2)))))
+
+
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-mairix)
+ (expr (head mark)))
+ (gnus-search-mairix-handle-mark (cdr expr)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr list))
+ (let ((key (cl-case (car expr)
+ (sender "f")
+ (from "f")
+ (to "t")
+ (cc "c")
+ (subject "s")
+ (id "m")
+ (body "b")
+ (address "a")
+ (recipient "tc")
+ (text "bs")
+ (attachment "n")
+ (t nil))))
+ (cond
+ ((consp (car expr))
+ (gnus-search-transform engine expr))
+ ((member (symbol-name (car expr)) gnus-search-date-keys)
+ (gnus-search-mairix-handle-date expr))
+ ((memq (car expr) '(size smaller larger))
+ (gnus-search-mairix-handle-size expr))
+ ;; Drop regular expressions.
+ ((string-match-p "\\`/" (cdr expr))
+ nil)
+ ;; Turn parenthesized phrases into multiple word terms. Again,
+ ;; this isn't quite what the user is asking for, but better to
+ ;; return false positives.
+ ((and key (string-match-p "[[:blank:]]" (cdr expr)))
+ (mapconcat
+ (lambda (s) (format "%s:%s" key s))
+ (split-string (gnus-search-mairix-treat-string
+ (cdr expr)))
+ " "))
+ (key (format "%s:%s" key
+ (gnus-search-mairix-treat-string
+ (cdr expr))))
+ (t nil))))
+
+(defun gnus-search-mairix-treat-string (str)
+ "Treat string for wildcards.
+Mairix accepts trailing wildcards, but not leading. Also remove
+double quotes."
+ (replace-regexp-in-string
+ "\\`\\*\\|\"" ""
+ (replace-regexp-in-string "\\*\\'" "=" str)))
+
+(defun gnus-search-mairix-handle-size (expr)
+ "Format a mairix size search.
+Assume \"size\" key is equal to \"larger\"."
+ (format
+ (if (eql (car expr) 'smaller)
+ "z:-%s"
+ "z:%s-")
+ (cdr expr)))
+
+(defun gnus-search-mairix-handle-mark (expr)
+ "Format a mairix mark search."
+ (let ((mark
+ (pcase (cdr expr)
+ ("flag" "f")
+ ("read" "s")
+ ("seen" "s")
+ ("replied" "r")
+ (_ nil))))
+ (when mark
+ (format "F:%s" mark))))
+
+(defun gnus-search-mairix-handle-date (expr)
+ (let ((str
+ (pcase (cdr expr)
+ (`(nil ,m nil)
+ (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3))
+ (`(nil nil ,y)
+ (number-to-string y))
+ (`(,d ,m nil)
+ (format "%s%02d"
+ (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3)
+ d))
+ (`(nil ,m ,y)
+ (format "%d%s"
+ y (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3)))
+ (`(,d ,m ,y)
+ (format "%d%02d%02d" y m d)))))
+ (format
+ (pcase (car expr)
+ ('date "d:%s")
+ ('since "d:%s-")
+ ('after "d:%s-")
+ ('before "d:-%s"))
+ str)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-mairix)
+ (qstring string)
+ query &optional _groups)
+ (with-slots (switches config-file) engine
+ (append `("--rcfile" ,config-file "-r")
+ switches
+ (when (alist-get 'thread query) (list "-t"))
+ (list qstring))))
+
+;;; Find-grep interface
+
+(cl-defmethod gnus-search-transform-expression ((_engine gnus-search-find-grep)
+ (_ list))
+ ;; Drop everything that isn't a plain string.
+ nil)
+
+(cl-defmethod gnus-search-run-search ((engine gnus-search-find-grep)
+ server query
+ &optional groups)
+ "Run find and grep to obtain matching articles."
+ (let* ((method (gnus-server-to-method server))
+ (sym (intern
+ (concat (symbol-name (car method)) "-directory")))
+ (directory (cadr (assoc sym (cddr method))))
+ (regexp (alist-get 'grep query))
+ (grep-options (slot-value engine 'grep-options))
+ (grouplist (or groups (gnus-search-get-active server)))
+ (buffer (slot-value engine 'proc-buffer)))
+ (unless directory
+ (error "No directory found in method specification of server %s"
+ server))
+ (apply
+ 'vconcat
+ (mapcar (lambda (x)
+ (let ((group x)
+ artlist)
+ (message "Searching %s using find-grep..."
+ (or group server))
+ (save-window-excursion
+ (set-buffer buffer)
+ (if (> gnus-verbose 6)
+ (pop-to-buffer (current-buffer)))
+ (cd directory) ; Using relative paths simplifies
+ ; postprocessing.
+ (let ((group
+ (if (not group)
+ "."
+ ;; Try accessing the group literally as
+ ;; well as interpreting dots as directory
+ ;; separators so the engine works with
+ ;; plain nnml as well as the Gnus Cache.
+ (let ((group (gnus-group-real-name group)))
+ ;; Replace cl-func find-if.
+ (if (file-directory-p group)
+ group
+ (if (file-directory-p
+ (setq group
+ (replace-regexp-in-string
+ "\\." "/"
+ group nil t)))
+ group))))))
+ (unless group
+ (error "Cannot locate directory for group"))
+ (save-excursion
+ (apply
+ 'call-process "find" nil t
+ "find" group "-maxdepth" "1" "-type" "f"
+ "-name" "[0-9]*" "-exec"
+ (slot-value engine 'grep-program)
+ `("-l" ,@(and grep-options
+ (split-string grep-options "\\s-" t))
+ "-e" ,regexp "{}" "+"))))
+
+ ;; Translate relative paths to group names.
+ (while (not (eobp))
+ (let* ((path (split-string
+ (buffer-substring
+ (point)
+ (line-end-position)) "/" t))
+ (art (string-to-number (car (last path)))))
+ (while (string= "." (car path))
+ (setq path (cdr path)))
+ (let ((group (mapconcat #'identity
+ (cl-subseq path 0 -1)
+ ".")))
+ (push
+ (vector (gnus-group-full-name group server) art 0)
+ artlist))
+ (forward-line 1)))
+ (message "Searching %s using find-grep...done"
+ (or group server))
+ artlist)))
+ grouplist))))
+
+;;; Util Code:
+
+(defun gnus-search-run-query (specs)
+ "Invoke appropriate search engine function."
+ ;; For now, run the searches synchronously. At some point
+ ;; multiple-server searches can each be run in their own thread,
+ ;; allowing concurrent searches of multiple backends. At present
+ ;; this causes problems when searching more than one server that
+ ;; uses `nntp-server-buffer', as their return values are written
+ ;; interleaved into that buffer. Anyway, that's the reason for the
+ ;; `mapc'.
+ (let* ((results [])
+ (prepared-query (gnus-search-prepare-query
+ (alist-get 'search-query-spec specs)))
+ (limit (alist-get 'limit prepared-query)))
+ (mapc
+ (pcase-lambda (`(,server . ,groups))
+ (let ((search-engine (gnus-search-server-to-engine server)))
+ (setq results
+ (vconcat
+ (gnus-search-run-search
+ search-engine server prepared-query groups)
+ results))))
+ (alist-get 'search-group-spec specs))
+ ;; Some search engines do their own limiting, but some don't, so
+ ;; do it again here. This is bad because, if the user is
+ ;; searching multiple groups, they would reasonably expect the
+ ;; limiting to apply to the search results *after sorting*. Doing
+ ;; it this way is liable to, for instance, eliminate all results
+ ;; from a later group entirely.
+ (if limit
+ (seq-subseq results 0 (min limit (length results)))
+ results)))
+
+(defun gnus-search-prepare-query (query-spec)
+ "Accept a search query in raw format, and prepare it.
+QUERY-SPEC is an alist produced by functions such as
+`gnus-group-make-search-group', and contains at least a 'query
+key, and possibly some meta keys. This function extracts any
+additional meta keys from the 'query string, and parses the
+remaining string, then adds all that to the top-level spec."
+ (let ((query (alist-get 'query query-spec))
+ val)
+ (when (stringp query)
+ ;; Look for these meta keys:
+ (while (string-match
+ "\\(thread\\|grep\\|limit\\|raw\\):\\([^ ]+\\)"
+ query)
+ (setq val (match-string 2 query))
+ (setf (alist-get (intern (match-string 1 query)) query-spec)
+ ;; This is stupid.
+ (cond
+ ((equal val "t"))
+ ((null (zerop (string-to-number val)))
+ (string-to-number val))
+ (t val)))
+ (setq query
+ (string-trim (replace-match "" t t query 0)))
+ (setf (alist-get 'query query-spec) query)))
+ (when (and gnus-search-use-parsed-queries
+ (null (alist-get 'raw query-spec)))
+ (setf (alist-get 'parsed-query query-spec)
+ (gnus-search-parse-query query)))
+ query-spec))
+
+;; This should be done once at Gnus startup time, when the servers are
+;; first opened, and the resulting engine instance attached to the
+;; server.
+(defun gnus-search-server-to-engine (srv)
+ (let* ((method (gnus-server-to-method srv))
+ (engine-config (assoc 'gnus-search-engine (cddr method)))
+ (server (or (cdr-safe
+ (assoc-string srv gnus-search-engine-instance-alist t))
+ (nth 1 engine-config)
+ (cdr-safe (assoc (car method) gnus-search-default-engines))
+ (when-let ((old (assoc 'nnir-search-engine
+ (cddr method))))
+ (nnheader-message
+ 8 "\"nnir-search-engine\" is no longer a valid parameter")
+ (nth 1 old))))
+ inst)
+ (setq server
+ (pcase server
+ ('notmuch 'gnus-search-notmuch)
+ ('namazu 'gnus-search-namazu)
+ ('find-grep 'gnus-search-find-grep)
+ ('imap 'gnus-search-imap)
+ (_ server))
+ inst
+ (cond
+ ((null server) nil)
+ ((eieio-object-p server)
+ server)
+ ((class-p server)
+ (make-instance server))
+ (t nil)))
+ (if inst
+ (unless (assoc-string srv gnus-search-engine-instance-alist t)
+ (when (cddr engine-config)
+ ;; We're not being completely backward-compatible here,
+ ;; because we're not checking for nnir-specific config
+ ;; options in the server definition.
+ (pcase-dolist (`(,key ,value) (cddr engine-config))
+ (condition-case nil
+ (setf (slot-value inst key) value)
+ ((invalid-slot-name invalid-slot-type)
+ (nnheader-message
+ 5 "Invalid search engine parameter: (%s %s)"
+ key value)))))
+ (push (cons srv inst) gnus-search-engine-instance-alist))
+ (error "No search engine defined for %s" srv))
+ inst))
+
+(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
+
+(defun gnus-search-thread (header)
+ "Make an nnselect group based on the thread containing the article
+header. The current server will be searched. If the registry is
+installed, the server that the registry reports the current
+article came from is also searched."
+ (let* ((ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
+ (server
+ (list (list (gnus-method-to-server
+ (gnus-find-method-for-group gnus-newsgroup-name)))))
+ (registry-group (and
+ (bound-and-true-p gnus-registry-enabled)
+ (car (gnus-registry-get-id-key
+ (mail-header-id header) 'group))))
+ (registry-server
+ (and registry-group
+ (gnus-method-to-server
+ (gnus-find-method-for-group registry-group)))))
+ (when registry-server
+ (cl-pushnew (list registry-server) server :test #'equal))
+ (gnus-group-make-search-group nil (list
+ (cons 'search-query-spec query)
+ (cons 'search-group-spec server)))
+ (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
+
+(defun gnus-search-get-active (srv)
+ (let ((method (gnus-server-to-method srv))
+ groups)
+ (gnus-request-list method)
+ (with-current-buffer nntp-server-buffer
+ (let ((cur (current-buffer)))
+ (goto-char (point-min))
+ (unless (or (null gnus-search-ignored-newsgroups)
+ (string= gnus-search-ignored-newsgroups ""))
+ (delete-matching-lines gnus-search-ignored-newsgroups))
+ (if (eq (car method) 'nntp)
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-decoded-name
+ (gnus-group-full-name
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point)))
+ method))
+ groups))
+ (forward-line))
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-decoded-name
+ (if (eq (char-after) ?\")
+ (gnus-group-full-name (read cur) method)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ (gnus-group-full-name name method))))
+ groups))
+ (forward-line)))))
+ groups))
+
+(defvar gnus-search-minibuffer-map
+ (let ((km (make-sparse-keymap)))
+ (set-keymap-parent km minibuffer-local-map)
+ (define-key km (kbd "TAB") #'completion-at-point)
+ km))
+
+(defun gnus-search--complete-key-data ()
+ "Potentially return completion data for a search key or value."
+ (let* ((key-start (save-excursion
+ (or (re-search-backward " " (minibuffer-prompt-end) t)
+ (goto-char (minibuffer-prompt-end)))
+ (skip-chars-forward " -")
+ (point)))
+ (after-colon (save-excursion
+ (when (re-search-backward ":" key-start t)
+ (1+ (point)))))
+ in-string)
+ (if after-colon
+ ;; We're in the value part of a key:value pair, which we
+ ;; only handle in a contact-completion context.
+ (when (and gnus-search-contact-tables
+ (save-excursion
+ (re-search-backward "\\<-?\\(\\w+\\):" key-start t)
+ (member (match-string 1)
+ '("from" "to" "cc"
+ "bcc" "recipient" "address"))))
+ (setq in-string (nth 3 (syntax-ppss)))
+ (list (if in-string (1+ after-colon) after-colon)
+ (point) (apply #'completion-table-merge
+ gnus-search-contact-tables)
+ :exit-function
+ (lambda (str status)
+ ;; If the value contains spaces, make sure it's
+ ;; quoted.
+ (when (and (memql status '(exact finished))
+ (or (string-match-p " " str)
+ in-string))
+ (unless (looking-at-p "\\s\"")
+ (insert "\""))
+ ;; Unless we already have an opening quote...
+ (unless in-string
+ (save-excursion
+ (goto-char after-colon)
+ (insert "\"")))))))
+ (list
+ key-start (point) gnus-search-expandable-keys
+ :exit-function (lambda (_s status)
+ (when (memql status '(exact finished))
+ (insert ":")))))))
+
+(defun gnus-search-make-spec (arg)
+ (list (cons 'query
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (add-hook 'completion-at-point-functions
+ #'gnus-search--complete-key-data
+ nil t))
+ (read-from-minibuffer
+ "Query: " nil gnus-search-minibuffer-map
+ nil 'gnus-search-history)))
+ (cons 'raw arg)))
+
+(provide 'gnus-search)
+;;; gnus-search.el ends here
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
index 278e3a5d6f3..5d8f9b55deb 100644
--- a/lisp/gnus/gnus-sieve.el
+++ b/lisp/gnus/gnus-sieve.el
@@ -29,8 +29,6 @@
(require 'gnus)
(require 'gnus-sum)
-(require 'format-spec)
-(autoload 'sieve-mode "sieve-mode")
(eval-when-compile
(require 'sieve))
@@ -88,10 +86,10 @@ See the documentation for these variables and functions for details."
(save-buffer)
(shell-command
(format-spec gnus-sieve-update-shell-command
- (format-spec-make ?f gnus-sieve-file
- ?s (or (cadr (gnus-server-get-method
- nil gnus-sieve-select-method))
- "")))))
+ `((?f . ,gnus-sieve-file)
+ (?s . ,(or (cadr (gnus-server-get-method
+ nil gnus-sieve-select-method))
+ ""))))))
;;;###autoload
(defun gnus-sieve-generate ()
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index d58bd7a73b5..6beb543e5a1 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -34,7 +34,7 @@
(require 'gnus-range)
(require 'gnus-cloud)
-(autoload 'gnus-group-make-nnir-group "nnir")
+(autoload 'gnus-group-read-ephemeral-search-group "nnselect")
(defcustom gnus-server-exit-hook nil
"Hook run when exiting the server buffer."
@@ -176,7 +176,7 @@ If nil, a faster, but more primitive, buffer is used instead."
"g" gnus-server-regenerate-server
- "G" gnus-group-make-nnir-group
+ "G" gnus-group-read-ephemeral-search-group
"z" gnus-server-compact-server
@@ -309,7 +309,7 @@ The following commands are available:
;; `gnus-server-buffer' selected as the current buffer, but not always (I
;; bumped into it when starting from a dedicated *Group* frame, and
;; gnus-configure-windows opened *Server* into its own dedicated frame).
- (with-current-buffer (get-buffer-create gnus-server-buffer)
+ (with-current-buffer (gnus-get-buffer-create gnus-server-buffer)
(gnus-server-mode)
(gnus-server-prepare)))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index dbe92a164d0..615f8dfa877 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -31,6 +31,7 @@
(require 'gnus-range)
(require 'gnus-util)
(require 'gnus-cloud)
+(require 'gnus-dbus)
(autoload 'message-make-date "message")
(autoload 'gnus-agent-read-servers-validate "gnus-agent")
(autoload 'gnus-agent-save-local "gnus-agent")
@@ -730,7 +731,7 @@ the first newsgroup."
;; Remove Gnus frames.
(gnus-kill-gnus-frames))
-(defun gnus-no-server-1 (&optional arg slave)
+(defun gnus-no-server-1 (&optional arg child)
"Read network news.
If ARG is a positive number, Gnus will use that as the startup
level. If ARG is nil, Gnus will be started at level 2
@@ -739,11 +740,11 @@ and not a positive number, Gnus will prompt the user for the name
of an NNTP server to use. As opposed to \\[gnus], this command
will not connect to the local server."
(let ((val (or arg (1- gnus-level-default-subscribed))))
- (gnus val t slave)
+ (gnus val t child)
(make-local-variable 'gnus-group-use-permanent-levels)
(setq gnus-group-use-permanent-levels val)))
-(defun gnus-1 (&optional arg dont-connect slave)
+(defun gnus-1 (&optional arg dont-connect child)
"Read network news.
If ARG is non-nil and a positive number, Gnus will use that as the
startup level. If ARG is non-nil and not a positive number, Gnus will
@@ -761,7 +762,7 @@ prompt the user for the name of an NNTP server to use."
(gnus-splash)
(gnus-run-hooks 'gnus-before-startup-hook)
(nnheader-init-server-buffer)
- (setq gnus-slave slave)
+ (setq gnus-child child)
(gnus-read-init-file)
;; Add "native" to gnus-predefined-server-alist just to have a
@@ -790,7 +791,7 @@ prompt the user for the name of an NNTP server to use."
(gnus-make-newsrc-file gnus-startup-file))
;; Read the dribble file.
- (when (or gnus-slave gnus-use-dribble-file)
+ (when (or gnus-child gnus-use-dribble-file)
(gnus-dribble-read-file))
;; Do the actual startup.
@@ -798,6 +799,8 @@ prompt the user for the name of an NNTP server to use."
(gnus-run-hooks 'gnus-setup-news-hook)
(when gnus-agent
(gnus-request-create-group "queue" '(nndraft "")))
+ (when gnus-dbus-close-on-sleep
+ (gnus-dbus-register-sleep-signal))
(gnus-start-draft-setup)
;; Generate the group buffer.
(gnus-group-list-groups level)
@@ -1008,11 +1011,11 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
;; Possibly eval the dribble file.
(and init
- (or gnus-use-dribble-file gnus-slave)
+ (or gnus-use-dribble-file gnus-child)
(gnus-dribble-eval-file))
- ;; Slave Gnusii should then clear the dribble buffer.
- (when (and init gnus-slave)
+ ;; Child Gnusii should then clear the dribble buffer.
+ (when (and init gnus-child)
(gnus-dribble-clear))
(gnus-update-format-specifications)
@@ -1030,7 +1033,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
;; Find new newsgroups and treat them.
(when (and init gnus-check-new-newsgroups (not level)
(gnus-check-server gnus-select-method)
- (not gnus-slave)
+ (not gnus-child)
gnus-plugged)
(gnus-find-new-newsgroups))
@@ -1040,8 +1043,8 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
(gnus-server-opened gnus-select-method))
(gnus-check-bogus-newsgroups))
- ;; Read any slave files.
- (gnus-master-read-slave-newsrc)
+ ;; Read any child files.
+ (gnus-parent-read-child-newsrc)
;; Find the number of unread articles in each non-dead group.
(let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
@@ -1256,19 +1259,19 @@ INFO-LIST), otherwise it's a list in the format of the
`gnus-newsrc-hashtb' entries. LEVEL is the new level of the
group, OLDLEVEL is the old level and PREVIOUS is the group (a
string name) to insert this group before."
- (let (group info active num)
- ;; Glean what info we can from the arguments.
- (if (consp entry)
- (setq group (if fromkilled (nth 1 entry) (car (nth 1 entry))))
- (setq group entry))
+ ;; Glean what info we can from the arguments.
+ (let ((group (if (consp entry)
+ (if fromkilled (nth 1 entry) (car (nth 1 entry)))
+ entry))
+ info active num)
(when (and (stringp entry)
oldlevel
(< oldlevel gnus-level-zombie))
(setq entry (gnus-group-entry entry)))
- (if (and (not oldlevel)
- (consp entry))
- (setq oldlevel (gnus-info-level (nth 1 entry)))
- (setq oldlevel (or oldlevel gnus-level-killed)))
+ (setq oldlevel (if (and (not oldlevel)
+ (consp entry))
+ (gnus-info-level (nth 1 entry))
+ (or oldlevel gnus-level-killed)))
;; This table is used for completion, so put a dummy entry there.
(unless (gethash group gnus-active-hashtb)
@@ -1799,7 +1802,7 @@ backend check whether the group actually exists."
;; by one.
(t
(dolist (info infos)
- (gnus-activate-group (gnus-info-group info) nil nil method t))))))
+ (gnus-activate-group (gnus-info-group info) t nil method t))))))
(defun gnus-make-hashtable-from-newsrc-alist ()
"Create a hash table from `gnus-newsrc-alist'.
@@ -2111,6 +2114,7 @@ The info element is shared with the same element of
((string= gnus-ignored-newsgroups "")
(delete-matching-lines "^to\\."))
(t
+ ;; relint suppression: Duplicated alternative branch
(delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups))))
(goto-char (point-min))
@@ -2737,15 +2741,15 @@ values from `gnus-newsrc-hashtb', and write a new value of
(gnus-agent-save-local force))
(save-excursion
- (if (and (or gnus-use-dribble-file gnus-slave)
+ (if (and (or gnus-use-dribble-file gnus-child)
(not force)
(or (not (buffer-live-p gnus-dribble-buffer))
(zerop (with-current-buffer gnus-dribble-buffer
(buffer-size)))))
(gnus-message 4 "(No changes need to be saved)")
(gnus-run-hooks 'gnus-save-newsrc-hook)
- (if gnus-slave
- (gnus-slave-save-newsrc)
+ (if gnus-child
+ (gnus-child-save-newsrc)
;; Save .newsrc only if the select method is an NNTP method.
;; The .newsrc file is for interoperability with other
;; newsreaders, so saving non-NNTP groups there doesn't make
@@ -2812,7 +2816,7 @@ values from `gnus-newsrc-hashtb', and write a new value of
(file-exists-p working-file)))
(unwind-protect
- (progn
+ (with-file-modes (file-modes startup-file)
(gnus-with-output-to-file working-file
(gnus-gnus-to-quick-newsrc-format)
(gnus-run-hooks 'gnus-save-quick-newsrc-hook))
@@ -2822,14 +2826,12 @@ values from `gnus-newsrc-hashtb', and write a new value of
;; file.
(let ((buffer-backed-up nil)
(buffer-file-name startup-file)
- (file-precious-flag t)
- (setmodes (file-modes startup-file)))
+ (file-precious-flag t))
;; Backup the current version of the startup file.
(backup-buffer)
;; Replace the existing startup file with the temp file.
(rename-file working-file startup-file t)
- (gnus-set-file-modes startup-file setmodes)
(setq gnus-save-newsrc-file-last-timestamp
(file-attribute-modification-time
(file-attributes startup-file)))))
@@ -2990,55 +2992,61 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
;;;
-;;; Slave functions.
+;;; Child functions.
;;;
-(defvar gnus-slave-mode nil)
+(defvar gnus-child-mode nil)
-(defun gnus-slave-mode ()
- "Minor mode for slave Gnusae."
- ;; FIXME: gnus-slave-mode appears to never be set (i.e. it'll always be nil):
+(defun gnus-child-mode ()
+ "Minor mode for child Gnusae."
+ ;; FIXME: gnus-child-mode appears to never be set (i.e. it'll always be nil):
;; Remove, or fix and use define-minor-mode.
- (add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
- (gnus-run-hooks 'gnus-slave-mode-hook))
+ (add-minor-mode 'gnus-child-mode " Child" (make-sparse-keymap))
+ (gnus-run-hooks 'gnus-child-mode-hook))
-(defun gnus-slave-save-newsrc ()
+(define-obsolete-function-alias 'gnus-slave-mode #'gnus-child-mode "28.1")
+(define-obsolete-variable-alias 'gnus-slave-mode-hook 'gnus-child-mode-hook
+ "28.1")
+
+(defun gnus-child-save-newsrc ()
(with-current-buffer gnus-dribble-buffer
- (let ((slave-name
- (make-temp-file (concat gnus-current-startup-file "-slave-")))
- (modes (ignore-errors
- (file-modes (concat gnus-current-startup-file ".eld")))))
- (let ((coding-system-for-write gnus-ding-file-coding-system))
- (gnus-write-buffer slave-name))
- (when modes
- (gnus-set-file-modes slave-name modes)))))
-
-(defun gnus-master-read-slave-newsrc ()
- (let ((slave-files
+ (with-file-modes (or (ignore-errors
+ (file-modes
+ (concat gnus-current-startup-file ".eld")))
+ (default-file-modes))
+ (let ((child-name
+ (make-temp-file (concat gnus-current-startup-file "-child-"))))
+ (let ((coding-system-for-write gnus-ding-file-coding-system))
+ (gnus-write-buffer child-name))))))
+
+(defun gnus-parent-read-child-newsrc ()
+ (let ((child-files
(directory-files
(file-name-directory gnus-current-startup-file)
t (concat
"^" (regexp-quote
- (concat
- (file-name-nondirectory gnus-current-startup-file)
- "-slave-")))
+ (file-name-nondirectory gnus-current-startup-file))
+ ;; When the obsolete variables like
+ ;; `gnus-slave-mode-hook' etc are removed, the "slave"
+ ;; bit of this regexp should also be removed.
+ "\\(-child-\\|-slave-\\)")
t))
file)
- (if (not slave-files)
- () ; There are no slave files to read.
- (gnus-message 7 "Reading slave newsrcs...")
- (with-current-buffer (gnus-get-buffer-create " *gnus slave*")
- (setq slave-files
+ (if (not child-files)
+ () ; There are no child files to read.
+ (gnus-message 7 "Reading child newsrcs...")
+ (with-current-buffer (gnus-get-buffer-create " *gnus child*")
+ (setq child-files
(sort (mapcar (lambda (file)
(list (file-attribute-modification-time
(file-attributes file))
file))
- slave-files)
+ child-files)
(lambda (f1 f2)
(time-less-p (car f1) (car f2)))))
- (while slave-files
+ (while child-files
(erase-buffer)
- (setq file (nth 1 (car slave-files)))
+ (setq file (nth 1 (car child-files)))
(nnheader-insert-file-contents file)
(when (condition-case ()
(progn
@@ -3047,12 +3055,12 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
(error
(gnus-error 3.2 "Possible error in %s" file)
nil))
- (unless gnus-slave ; Slaves shouldn't delete these files.
+ (unless gnus-child ; Children shouldn't delete these files.
(ignore-errors
(delete-file file))))
- (setq slave-files (cdr slave-files))))
+ (setq child-files (cdr child-files))))
(gnus-dribble-touch)
- (gnus-message 7 "Reading slave newsrcs...done"))))
+ (gnus-message 7 "Reading child newsrcs...done"))))
;;;
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 9b11d5878d9..561f199531e 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -85,8 +85,9 @@
(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
-(autoload 'nnir-article-rsv "nnir" nil nil 'macro)
-(autoload 'nnir-article-group "nnir" nil nil 'macro)
+(autoload 'nnselect-article-rsv "nnselect" nil nil)
+(autoload 'nnselect-article-group "nnselect" nil nil)
+(autoload 'gnus-nnselect-group-p "nnselect" nil nil)
(defcustom gnus-kill-summary-on-exit t
"If non-nil, kill the summary buffer when you exit from it.
@@ -144,11 +145,14 @@ If t, fetch all the available old headers."
:type '(choice number
(sexp :menu-tag "other" t)))
-(defcustom gnus-refer-thread-use-nnir nil
- "Use nnir to search an entire server when referring threads.
+(define-obsolete-variable-alias 'gnus-refer-thread-use-nnir
+ 'gnus-refer-thread-use-search "28.1")
+
+(defcustom gnus-refer-thread-use-search nil
+ "Search an entire server when referring threads.
A nil value will only search for thread-related articles in the
current group."
- :version "24.1"
+ :version "28.1"
:group 'gnus-thread
:type 'boolean)
@@ -884,6 +888,7 @@ controls how articles are sorted."
(function-item gnus-article-sort-by-subject)
(function-item gnus-article-sort-by-date)
(function-item gnus-article-sort-by-score)
+ (function-item gnus-article-sort-by-rsv)
(function-item gnus-article-sort-by-random)
(function :tag "other"))
(boolean :tag "Reverse order"))))
@@ -927,6 +932,7 @@ subthreads, customize `gnus-subthread-sort-functions'."
(function-item gnus-thread-sort-by-subject)
(function-item gnus-thread-sort-by-date)
(function-item gnus-thread-sort-by-score)
+ (function-item gnus-thread-sort-by-rsv)
(function-item gnus-thread-sort-by-most-recent-number)
(function-item gnus-thread-sort-by-most-recent-date)
(function-item gnus-thread-sort-by-random)
@@ -1433,16 +1439,13 @@ the normal Gnus MIME machinery."
(?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
(?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
(?L gnus-tmp-lines ?s)
- (?Z (or (nnir-article-rsv (mail-header-number gnus-tmp-header))
- 0)
- ?d)
- (?G (or (nnir-article-group (mail-header-number gnus-tmp-header))
- "")
- ?s)
+ (?Z (or (nnselect-article-rsv (mail-header-number gnus-tmp-header))
+ 0) ?d)
+ (?G (or (nnselect-article-group (mail-header-number gnus-tmp-header))
+ "") ?s)
(?g (or (gnus-group-short-name
- (nnir-article-group (mail-header-number gnus-tmp-header)))
- "")
- ?s)
+ (nnselect-article-group (mail-header-number gnus-tmp-header)))
+ "") ?s)
(?O gnus-tmp-downloaded ?c)
(?I gnus-tmp-indentation ?s)
(?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
@@ -1501,9 +1504,9 @@ the type of the variable (string, integer, character, etc).")
;; This is here rather than in gnus-art for compilation reasons.
(defvar gnus-article-mode-line-format-alist
- (nconc '((?w (gnus-article-wash-status) ?s)
- (?m (gnus-article-mime-part-status) ?s))
- gnus-summary-mode-line-format-alist))
+ (append '((?w (gnus-article-wash-status) ?s)
+ (?m (gnus-article-mime-part-status) ?s))
+ gnus-summary-mode-line-format-alist))
(defvar gnus-last-search-regexp nil
"Default regexp for article search command.")
@@ -1619,6 +1622,8 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
(defvar gnus-newsgroup-sparse nil)
+(defvar gnus-newsgroup-selection nil)
+
(defvar gnus-current-article nil)
(defvar gnus-article-current nil)
(defvar gnus-current-headers nil)
@@ -1653,6 +1658,8 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
gnus-newsgroup-undownloaded
gnus-newsgroup-unsendable
+ gnus-newsgroup-selection
+
gnus-newsgroup-begin gnus-newsgroup-end
gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
gnus-newsgroup-last-folder gnus-newsgroup-last-file
@@ -1913,7 +1920,8 @@ increase the score of each group you read."
"," gnus-summary-best-unread-article
"[" gnus-summary-prev-unseen-article
"]" gnus-summary-next-unseen-article
- "\M-s" gnus-summary-search-article-forward
+ "\M-s\M-s" gnus-summary-search-article-forward
+ "\M-s\M-r" gnus-summary-search-article-backward
"\M-r" gnus-summary-search-article-backward
"\M-S" gnus-summary-repeat-search-article-forward
"\M-R" gnus-summary-repeat-search-article-backward
@@ -1982,6 +1990,7 @@ increase the score of each group you read."
"\M-K" gnus-summary-edit-global-kill
;; "V" gnus-version
"\C-c\C-d" gnus-summary-describe-group
+ "\C-c\C-p" gnus-summary-make-group-from-search
"q" gnus-summary-exit
"Q" gnus-summary-exit-no-update
"\C-c\C-i" gnus-info-find-node
@@ -4531,48 +4540,14 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
;; This function has to be called with point after the article number
;; on the beginning of the line.
(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
- (let ((eol (point-at-eol))
- header references in-reply-to)
-
+ (let (header)
;; overview: [num subject from date id refs chars lines misc]
(unwind-protect
- (let (x)
- (narrow-to-region (point) eol)
- (unless (eobp)
- (forward-char))
-
- (setq header
- (make-full-mail-header
- number ; number
- (condition-case () ; subject
- (gnus-remove-odd-characters
- (funcall gnus-decode-encoded-word-function
- (setq x (nnheader-nov-field))))
- (error x))
- (condition-case () ; from
- (gnus-remove-odd-characters
- (funcall gnus-decode-encoded-address-function
- (setq x (nnheader-nov-field))))
- (error x))
- (nnheader-nov-field) ; date
- (nnheader-nov-read-message-id number) ; id
- (setq references (nnheader-nov-field)) ; refs
- (nnheader-nov-read-integer) ; chars
- (nnheader-nov-read-integer) ; lines
- (unless (eobp)
- (if (looking-at "Xref: ")
- (goto-char (match-end 0)))
- (nnheader-nov-field)) ; Xref
- (nnheader-nov-parse-extra)))) ; extra
-
+ (narrow-to-region (point) (point-at-eol))
+ (unless (eobp)
+ (forward-char))
+ (setq header (nnheader-parse-nov number))
(widen))
-
- (when (and (string= references "")
- (setq in-reply-to (mail-header-extra header))
- (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
- (setf (mail-header-references header)
- (gnus-extract-message-id-from-in-reply-to in-reply-to)))
-
(when gnus-alter-header-function
(funcall gnus-alter-header-function header))
(gnus-dependencies-add-header header dependencies force-new)))
@@ -5103,6 +5078,17 @@ using some other form will lead to serious barfage."
(gnus-article-sort-by-date
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-by-rsv (h1 h2)
+ "Sort articles by rsv."
+ (when gnus-newsgroup-selection
+ (< (nnselect-article-rsv (mail-header-number h1))
+ (nnselect-article-rsv (mail-header-number h2)))))
+
+(defun gnus-thread-sort-by-rsv (h1 h2)
+ "Sort threads by root article rsv."
+ (gnus-article-sort-by-rsv
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
(defsubst gnus-article-sort-by-score (h1 h2)
"Sort articles by root article score.
Unscored articles will be counted as having a score of zero."
@@ -5352,7 +5338,8 @@ or a straight list of headers."
;; We remember that we probably want to output a dummy
;; root.
(setq gnus-tmp-dummy-line gnus-tmp-header)
- (setq gnus-tmp-prev-subject gnus-tmp-header))
+ (setq gnus-tmp-prev-subject
+ (gnus-simplify-subject-fully gnus-tmp-header)))
(t
;; We do not make a root for the gathered
;; sub-threads at all.
@@ -5632,22 +5619,32 @@ or a straight list of headers."
"Fetch headers of ARTICLES."
(gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name)
(prog1
- (if (eq 'nov
- (setq gnus-headers-retrieved-by
- (gnus-retrieve-headers
- articles gnus-newsgroup-name
- (or limit
- ;; We might want to fetch old headers, but
- ;; not if there is only 1 article.
- (and (or (and
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers)))
- (> (length articles) 1))
- gnus-fetch-old-headers)))))
- (gnus-get-newsgroup-headers-xover
- articles force-new dependencies gnus-newsgroup-name t)
- (gnus-get-newsgroup-headers dependencies force-new))
- (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
+ (pcase (setq gnus-headers-retrieved-by
+ (gnus-retrieve-headers
+ articles gnus-newsgroup-name
+ (or limit
+ ;; We might want to fetch old headers, but
+ ;; not if there is only 1 article.
+ (and (or (and
+ (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers)))
+ (> (length articles) 1))
+ gnus-fetch-old-headers))))
+ ('nov
+ (gnus-get-newsgroup-headers-xover
+ articles force-new dependencies gnus-newsgroup-name t))
+ ('headers
+ (gnus-get-newsgroup-headers dependencies force-new))
+ ((pred listp)
+ (let ((dependencies
+ (or dependencies
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-dependencies))))
+ (delq nil (mapcar #'(lambda (header)
+ (gnus-dependencies-add-header
+ header dependencies force-new))
+ gnus-headers-retrieved-by)))))
+ (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
@@ -5937,7 +5934,9 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(initial (gnus-parameter-large-newsgroup-initial
gnus-newsgroup-name))
(default (if only-read-p
- (or initial gnus-large-newsgroup)
+ (if (eq initial 'all)
+ nil
+ (or initial gnus-large-newsgroup))
number))
(input
(read-string
@@ -6241,8 +6240,8 @@ If WHERE is `summary', the summary mode line format will be used."
;; We might have to chop a bit of the string off...
(when (> (length mode-string) max-len)
(setq mode-string
- (concat (truncate-string-to-width mode-string (- max-len 3))
- "...")))))
+ (truncate-string-to-width
+ mode-string (- max-len 3) nil nil t)))))
;; Update the mode line.
(setq mode-line-buffer-identification
(gnus-mode-line-buffer-identification (list mode-string)))
@@ -6401,12 +6400,11 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(gnus-group-update-group group t))))))
(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
- (let ((cur nntp-server-buffer)
- (dependencies
+ (let ((dependencies
(or dependencies
(with-current-buffer gnus-summary-buffer
gnus-newsgroup-dependencies)))
- headers id end ref number
+ headers
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(save-current-buffer (condition-case nil
@@ -6414,146 +6412,15 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(error))
gnus-newsgroup-ignored-charsets)))
(with-current-buffer nntp-server-buffer
- ;; Translate all TAB characters into SPACE characters.
- (subst-char-in-region (point-min) (point-max) ?\t ? t)
- (subst-char-in-region (point-min) (point-max) ?\r ? t)
- (ietf-drums-unfold-fws)
(gnus-run-hooks 'gnus-parse-headers-hook)
- (let ((case-fold-search t)
- in-reply-to header p lines chars)
+ (let ((nnmail-extra-headers gnus-extra-headers)
+ header)
(goto-char (point-min))
- ;; Search to the beginning of the next header. Error messages
- ;; do not begin with 2 or 3.
- (while (re-search-forward "^[23][0-9]+ " nil t)
- (setq id nil
- ref nil)
- ;; This implementation of this function, with nine
- ;; search-forwards instead of the one re-search-forward and
- ;; a case (which basically was the old function) is actually
- ;; about twice as fast, even though it looks messier. You
- ;; can't have everything, I guess. Speed and elegance
- ;; doesn't always go hand in hand.
- (setq
- header
- (make-full-mail-header
- ;; Number.
- (prog1
- (setq number (read cur))
- (end-of-line)
- (setq p (point))
- (narrow-to-region (point)
- (or (and (search-forward "\n.\n" nil t)
- (- (point) 2))
- (point))))
- ;; Subject.
- (progn
- (goto-char p)
- (if (search-forward "\nsubject:" nil t)
- (funcall gnus-decode-encoded-word-function
- (nnheader-header-value))
- "(none)"))
- ;; From.
- (progn
- (goto-char p)
- (if (search-forward "\nfrom:" nil t)
- (funcall gnus-decode-encoded-address-function
- (nnheader-header-value))
- "(nobody)"))
- ;; Date.
- (progn
- (goto-char p)
- (if (search-forward "\ndate:" nil t)
- (nnheader-header-value) ""))
- ;; Message-ID.
- (progn
- (goto-char p)
- (setq id (if (re-search-forward
- "^message-id: *\\(<[^\n\t> ]+>\\)" nil t)
- ;; We do it this way to make sure the Message-ID
- ;; is (somewhat) syntactically valid.
- (buffer-substring (match-beginning 1)
- (match-end 1))
- ;; If there was no message-id, we just fake one
- ;; to make subsequent routines simpler.
- (nnheader-generate-fake-message-id number))))
- ;; References.
- (progn
- (goto-char p)
- (if (search-forward "\nreferences:" nil t)
- (progn
- (setq end (point))
- (prog1
- (nnheader-header-value)
- (setq ref
- (buffer-substring
- (progn
- (end-of-line)
- (search-backward ">" end t)
- (1+ (point)))
- (progn
- (search-backward "<" end t)
- (point))))))
- ;; Get the references from the in-reply-to header if there
- ;; were no references and the in-reply-to header looks
- ;; promising.
- (if (and (search-forward "\nin-reply-to:" nil t)
- (setq in-reply-to (nnheader-header-value))
- (string-match "<[^>]+>" in-reply-to))
- (let (ref2)
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (while (string-match "<[^>]+>" in-reply-to (match-end 0))
- (setq ref2 (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (when (> (length ref2) (length ref))
- (setq ref ref2)))
- ref)
- (setq ref nil))))
- ;; Chars.
- (progn
- (goto-char p)
- (if (search-forward "\nchars: " nil t)
- (if (numberp (setq chars (ignore-errors (read cur))))
- chars -1)
- -1))
- ;; Lines.
- (progn
- (goto-char p)
- (if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (ignore-errors (read cur))))
- lines -1)
- -1))
- ;; Xref.
- (progn
- (goto-char p)
- (and (search-forward "\nxref:" nil t)
- (nnheader-header-value)))
- ;; Extra.
- (when gnus-extra-headers
- (let ((extra gnus-extra-headers)
- out)
- (while extra
- (goto-char p)
- (when (search-forward
- (concat "\n" (symbol-name (car extra)) ":") nil t)
- (push (cons (car extra) (nnheader-header-value))
- out))
- (pop extra))
- out))))
- (when (equal id ref)
- (setq ref nil))
-
- (when gnus-alter-header-function
- (funcall gnus-alter-header-function header)
- (setq id (mail-header-id header)
- ref (gnus-parent-id (mail-header-references header))))
-
+ (while (setq header (nnheader-parse-head))
(when (setq header
(gnus-dependencies-add-header
header dependencies force-new))
- (push header headers))
- (goto-char (point-max))
- (widen))
+ (push header headers)))
(nreverse headers)))))
;; Goes through the xover lines and returns a list of vectors
@@ -7255,6 +7122,21 @@ The prefix argument ALL means to select all articles."
(setq info (copy-sequence (gnus-get-info group))
info (delq (gnus-info-params info) info))))))))))
+(defun gnus-summary-make-group-from-search ()
+ "Make a persistent group from the current ephemeral search group."
+ (interactive)
+ (if (not (gnus-nnselect-group-p gnus-newsgroup-name))
+ (gnus-message 3 "%s is not a search group" gnus-newsgroup-name)
+ (let ((name (gnus-read-group "Group name: ")))
+ (with-current-buffer gnus-group-buffer
+ (gnus-group-make-group
+ name
+ (list 'nnselect "nnselect")
+ nil
+ (list (cons 'nnselect-specs
+ (gnus-group-get-parameter gnus-newsgroup-name
+ 'nnselect-specs t))))))))
+
(defun gnus-summary-save-newsrc (&optional force)
"Save the current number of read/marked articles in the dribble buffer.
The dribble buffer will then be saved.
@@ -7310,7 +7192,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(when gnus-use-cache
(gnus-cache-write-active))
;; Remove entries for this group.
- (nnmail-purge-split-history (gnus-group-real-name group))
+ (nnmail-purge-split-history group)
;; Make all changes in this group permanent.
(unless quit-config
(gnus-run-hooks 'gnus-exit-group-hook)
@@ -7331,6 +7213,8 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-group-next-unread-group 1))
(setq group-point (point))
(gnus-article-stop-animations)
+ (unless leave-hidden
+ (gnus-configure-windows 'group 'force))
(if temporary
nil ;Nothing to do.
(set-buffer buf)
@@ -7350,8 +7234,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(if quit-config
(gnus-handle-ephemeral-exit quit-config)
(goto-char group-point)
- (unless leave-hidden
- (gnus-configure-windows 'group 'force))
;; If gnus-group-buffer is already displayed, make sure we also move
;; the cursor in the window that displays it.
(let ((win (get-buffer-window (current-buffer) 0)))
@@ -8698,7 +8580,8 @@ SCORE."
When called interactively, ID is the Message-ID of the current
article. If thread-only is non-nil limit the summary buffer to
these articles."
- (interactive (list (mail-header-id (gnus-summary-article-header))))
+ (interactive (list (mail-header-id (gnus-summary-article-header))
+ current-prefix-arg))
(let ((articles (gnus-articles-in-thread
(gnus-id-to-thread (gnus-root-id id))))
;;we REALLY want the whole thread---this prevents cut-threads
@@ -9121,25 +9004,24 @@ Return the number of articles fetched."
result))
(defun gnus-summary-refer-thread (&optional limit)
- "Fetch all articles in the current thread. For backends
-that know how to search for threads (currently only 'nnimap)
-a non-numeric prefix arg will use nnir to search the entire
-server; without a prefix arg only the current group is
-searched. If the variable `gnus-refer-thread-use-nnir' is
-non-nil the prefix arg has the reverse meaning. If no
-backend-specific `request-thread' function is available fetch
-LIMIT (the numerical prefix) old headers. If LIMIT is
-non-numeric or nil fetch the number specified by the
-`gnus-refer-thread-limit' variable."
+ "Fetch all articles in the current thread.
+For backends that know how to search for threads (currently only
+`nnimap') a non-numeric prefix arg will search the entire server;
+without a prefix arg only the current group is searched. If the
+variable `gnus-refer-thread-use-search' is non-nil the prefix arg
+has the reverse meaning. If no backend-specific `request-thread'
+function is available fetch LIMIT (the numerical prefix) old
+headers. If LIMIT is non-numeric or nil fetch the number
+specified by the `gnus-refer-thread-limit' variable."
(interactive "P")
(let* ((header (gnus-summary-article-header))
(id (mail-header-id header))
(gnus-inhibit-demon t)
(gnus-summary-ignore-duplicates t)
(gnus-read-all-available-headers t)
- (gnus-refer-thread-use-nnir
+ (gnus-refer-thread-use-search
(if (and (not (null limit)) (listp limit))
- (not gnus-refer-thread-use-nnir) gnus-refer-thread-use-nnir))
+ (not gnus-refer-thread-use-search) gnus-refer-thread-use-search))
(new-headers
(if (gnus-check-backend-function
'request-thread gnus-newsgroup-name)
@@ -9280,9 +9162,9 @@ non-numeric or nil fetch the number specified by the
(dolist (method gnus-refer-article-method)
(push (if (eq 'current method)
gnus-current-select-method
- (if (eq 'nnir (car method))
+ (if (eq 'nnselect (car method))
(list
- 'nnir
+ 'nnselect
(or (cadr method)
(gnus-method-to-server gnus-current-select-method)))
method))
@@ -9493,16 +9375,6 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'."
(push primary urls))
(delete-dups urls)))
-;; cf. `ediff-truncate-string-left', to become `string-truncate-left'
-;; in Emacs 28
-(defun gnus--string-truncate-left (string length)
- "Truncate STRING to LENGTH, replacing initial surplus with \"...\"."
- (let ((strlen (length string)))
- (if (<= strlen length)
- string
- (setq length (max 0 (- length 3)))
- (concat "..." (substring string (max 0 (- strlen 1 length)))))))
-
(defun gnus-shorten-url (url max)
"Return an excerpt from URL not exceeding MAX characters."
(if (<= (length url) max)
@@ -9512,7 +9384,7 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'."
(rest (concat (url-filename parsed)
(when-let ((target (url-target parsed)))
(concat "#" target)))))
- (concat host (gnus--string-truncate-left rest (- max (length host)))))))
+ (concat host (string-truncate-left rest (- max (length host)))))))
(defun gnus-summary-browse-url (&optional external)
"Scan the current article body for links, and offer to browse them.
@@ -9536,10 +9408,10 @@ default."
(cond ((= (length urls) 1)
(car urls))
((> (length urls) 1)
- (completing-read (format "URL to browse (default %s): "
- (gnus-shorten-url (car urls) 40))
- urls nil t nil nil
- (car urls)))))
+ (completing-read
+ (format-prompt "URL to browse"
+ (gnus-shorten-url (car urls) 40))
+ urls nil t nil nil (car urls)))))
(if target
(if external
(funcall browse-url-secondary-browser-function target)
@@ -10836,6 +10708,7 @@ groups."
;; We only have to update this line.
(save-excursion
(save-restriction
+ (nnheader-ms-strip-cr)
(message-narrow-to-head)
(let ((head (buffer-substring-no-properties
(point-min) (point-max)))
@@ -11664,7 +11537,7 @@ If ALL is non-nil, also mark ticked and dormant articles as read."
(gnus-save-hidden-threads
(let ((beg (point)))
;; We check that there are unread articles.
- (when (or all (gnus-summary-find-next))
+ (when (or all (gnus-summary-last-article-p) (gnus-summary-find-next))
(gnus-summary-catchup all t beg nil t)))))
(gnus-summary-position-point))
@@ -11933,8 +11806,6 @@ will not be hidden."
(defun gnus-summary-hide-thread ()
"Hide thread subtrees.
-If PREDICATE is supplied, threads that satisfy this predicate
-will not be hidden.
Returns nil if no threads were there to be hidden."
(interactive)
(beginning-of-line)
@@ -11955,9 +11826,9 @@ Returns nil if no threads were there to be hidden."
(overlay-put ol 'invisible 'gnus-sum)
(overlay-put ol 'evaporate t)))
(gnus-summary-goto-subject article)
+ ;; We moved backward past the start point (invisible thread?)
(when (> start (point))
- (message "Hiding the thread moved us backwards, aborting!")
- (goto-char (point-max))))
+ (goto-char starteol)))
(goto-char start)
nil))))
@@ -12291,7 +12162,7 @@ no matter what the properties `:decode' and `:headers' are."
(interactive (gnus-interactive "P\ny"))
(require 'gnus-art)
(let* ((articles (gnus-summary-work-articles n))
- (result-buffer "*Shell Command Output*")
+ (result-buffer shell-command-buffer-name)
(all-headers (not (memq sym '(nil r))))
(gnus-save-all-headers (or all-headers gnus-save-all-headers))
(raw (eq sym 'r))
@@ -12320,7 +12191,7 @@ no matter what the properties `:decode' and `:headers' are."
(buffer-string))))))
(put 'gnus-summary-save-in-pipe :headers headers))
(unless (zerop (length result))
- (if (with-current-buffer (get-buffer-create result-buffer)
+ (if (with-current-buffer (gnus-get-buffer-create result-buffer)
(erase-buffer)
(insert result)
(prog1
@@ -12508,7 +12379,7 @@ save those articles instead."
(gnus-activate-group to-newsgroup nil nil to-method)
(gnus-subscribe-group to-newsgroup))
(error "Couldn't create group %s" to-newsgroup)))
- (error "No such group: %s" to-newsgroup))
+ (user-error "No such group: %s" to-newsgroup))
to-newsgroup)))
(defvar gnus-summary-save-parts-counter)
@@ -12518,10 +12389,15 @@ save those articles instead."
"Save parts matching TYPE to DIR.
If REVERSE, save parts that do not match TYPE."
(interactive
- (list (read-string "Save parts of type: "
- (or (car gnus-summary-save-parts-type-history)
- gnus-summary-save-parts-default-mime)
- 'gnus-summary-save-parts-type-history)
+ (list (completing-read "Save parts of type: "
+ (progn
+ (gnus-summary-select-article nil t)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (delete-dups
+ (mapcar (lambda (h)
+ (mm-handle-media-type (cdr h)))
+ gnus-article-mime-handle-alist))))
+ nil nil nil 'gnus-summary-save-parts-type-history)
(setq gnus-summary-save-parts-last-directory
(read-directory-name "Save to directory: "
gnus-summary-save-parts-last-directory
@@ -13169,10 +13045,13 @@ If ALL is a number, fetch this number of articles."
(t
(when (and (numberp gnus-large-newsgroup)
(> len gnus-large-newsgroup))
- (let* ((cursor-in-echo-area nil)
- (initial (gnus-parameter-large-newsgroup-initial
- gnus-newsgroup-name))
- (input
+ (let ((cursor-in-echo-area nil)
+ (initial (gnus-parameter-large-newsgroup-initial
+ gnus-newsgroup-name))
+ input)
+ (when (eq initial 'all)
+ (setq initial len))
+ (setq input
(read-string
(format
"How many articles from %s (%s %d): "
@@ -13181,7 +13060,7 @@ If ALL is a number, fetch this number of articles."
len)
nil nil
(and initial
- (number-to-string initial)))))
+ (number-to-string initial))))
(unless (string-match "^[ \t]*$" input)
(setq all (string-to-number input))
(if (< all len)
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index ffd26bb30f4..c913002f70b 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -897,9 +897,7 @@ articles in the topic and its subtopics."
(let ((inhibit-read-only t))
(unless gnus-topic-inhibit-change-level
(gnus-group-goto-group (or (car (nth 1 previous)) group))
- (when (and gnus-topic-mode
- gnus-topic-alist
- (not gnus-topic-inhibit-change-level))
+ (when (and gnus-topic-mode gnus-topic-alist (gnus-current-topic))
;; Remove the group from the topics.
(if (and (< oldlevel gnus-level-zombie)
(>= level gnus-level-zombie))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index f255cfc74a0..ef811c65b86 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -455,9 +455,7 @@ displayed in the echo area."
(> message-log-max 0)
(/= (length str) 0))
(setq time (current-time))
- (with-current-buffer (if (fboundp 'messages-buffer)
- (messages-buffer)
- (get-buffer-create "*Messages*"))
+ (with-current-buffer (messages-buffer)
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert ,timestamp str "\n")
@@ -768,7 +766,7 @@ nil. See also `gnus-bind-print-variables'."
If there's no subdirectory, delete DIRECTORY as well."
(when (file-directory-p directory)
(let ((files (directory-files
- directory t (rx (or (not ".") "..."))))
+ directory t directory-files-no-dot-files-regexp))
file dir)
(while files
(setq file (pop files))
@@ -950,7 +948,7 @@ FILENAME exists and is Babyl format."
(setq rmail-default-rmail-file filename) ; 22
(setq rmail-default-file filename)) ; 23
(let ((artbuf (current-buffer))
- (tmpbuf (get-buffer-create " *Gnus-output*"))
+ (tmpbuf (gnus-get-buffer-create " *Gnus-output*"))
;; Babyl rmail.el defines this, mbox does not.
(babyl (fboundp 'rmail-insert-rmail-file-header)))
(save-excursion
@@ -1015,6 +1013,12 @@ FILENAME exists and is Babyl format."
(rmail-swap-buffers-maybe)
(rmail-maybe-set-message-counters))
(widen)
+ (unless babyl
+ (goto-char (point-max))
+ ;; Ensure we have a blank line before the next message.
+ (unless (bolp)
+ (insert "\n"))
+ (insert "\n"))
(narrow-to-region (point-max) (point-max)))
(insert-buffer-substring tmpbuf)
(when msg
@@ -1036,7 +1040,7 @@ FILENAME exists and is Babyl format."
(require 'nnmail)
(setq filename (expand-file-name filename))
(let ((artbuf (current-buffer))
- (tmpbuf (get-buffer-create " *Gnus-output*")))
+ (tmpbuf (gnus-get-buffer-create " *Gnus-output*")))
(save-excursion
;; Create the file, if it doesn't exist.
(when (and (not (get-file-buffer filename))
@@ -1179,7 +1183,7 @@ ARG is passed to the first function."
(maphash
(lambda (group active)
(when active
- (insert (format "%s %d %d y\n"
+ (insert (format "%S %d %d y\n"
(if full-names
group
(gnus-group-real-name group))
@@ -1345,6 +1349,61 @@ forbidden in URL encoding."
(setq tmp (concat tmp str))
tmp))
+(defun gnus-base64-repad (str &optional reject-newlines line-length no-check)
+ "Take a base 64-encoded string and return it padded correctly.
+Existing padding is ignored.
+
+If any combination of CR and LF characters are present and
+REJECT-NEWLINES is nil, remove them; otherwise raise an error.
+If LINE-LENGTH is set and the string (or any line in the string
+if REJECT-NEWLINES is nil) is longer than that number, raise an
+error. Common line length for input characters are 76 plus CRLF
+(RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including
+CRLF (RFC 5321 SMTP).
+
+If NOCHECK, don't check anything, but just repad."
+ ;; RFC 4648 specifies that:
+ ;; - three 8-bit inputs make up a 24-bit group
+ ;; - the 24-bit group is broken up into four 6-bit values
+ ;; - each 6-bit value is mapped to one character of the base 64 alphabet
+ ;; - if the final 24-bit quantum is filled with only 8 bits the output
+ ;; will be two base 64 characters followed by two "=" padding characters
+ ;; - if the final 24-bit quantum is filled with only 16 bits the output
+ ;; will be three base 64 character followed by one "=" padding character
+ ;;
+ ;; RFC 4648 section 3 considerations:
+ ;; - if reject-newlines is nil (default), concatenate multi-line
+ ;; input (3.1, 3.3)
+ ;; - if line-length is set, error on input exceeding the limit (3.1)
+ ;; - reject characters outside base encoding (3.3, also section 12)
+ ;;
+ ;; RFC 5322 section 2.2.3 consideration:
+ ;; Because base 64-encoded strings can appear in long header fields, remove
+ ;; folding whitespace while still observing the RFC 4648 decisions above.
+ (when no-check
+ (setq str (replace-regexp-in-string "[\n\r \t]+" "" str)));
+ (let ((splitstr (split-string str "[ \t]*[\r\n]+[ \t]?" t)))
+ (when (and reject-newlines (> (length splitstr) 1))
+ (error "Invalid Base64 string"))
+ (dolist (substr splitstr)
+ (when (and line-length (> (length substr) line-length))
+ (error "Base64 string exceeds line-length"))
+ (when (string-match "[^A-Za-z0-9+/=]" substr)
+ (error "Invalid Base64 string")))
+ (let* ((str (string-join splitstr))
+ (len (length str)))
+ (when (string-match "=" str)
+ (setq len (match-beginning 0)))
+ (concat
+ (substring str 0 len)
+ (make-string (/
+ (- 24
+ (pcase (mod (* len 6) 24)
+ (`0 24)
+ (n n)))
+ 6)
+ ?=)))))
+
(defun gnus-make-predicate (spec)
"Transform SPEC into a function that can be called.
SPEC is a predicate specifier that contains stuff like `or', `and',
@@ -1457,7 +1516,7 @@ CHOICE is a list of the choice char and help message at IDX."
(setq tchar (read-char))
(when (not (assq tchar choice))
(setq tchar nil)
- (setq buf (get-buffer-create "*Gnus Help*"))
+ (setq buf (gnus-get-buffer-create "*Gnus Help*"))
(pop-to-buffer buf)
(fundamental-mode)
(buffer-disable-undo)
@@ -1601,10 +1660,10 @@ empty directories from OLD-PATH."
(file-truename
(concat old-dir "..")))))))))
-(defun gnus-set-file-modes (filename mode)
+(defun gnus-set-file-modes (filename mode &optional flag)
"Wrapper for set-file-modes."
(ignore-errors
- (set-file-modes filename mode)))
+ (set-file-modes filename mode flag)))
(defun gnus-rescale-image (image size)
"Rescale IMAGE to SIZE if possible.
@@ -1654,6 +1713,7 @@ The first found will be returned if a file has hard or symbolic links."
"To each element of LIST apply PREDICATE.
Return nil if LIST is no list or is empty or some test returns nil;
otherwise, return t."
+ (declare (obsolete nil "28.1"))
(when (and list (listp list))
(let ((result (mapcar predicate list)))
(not (memq nil result)))))
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 5902f2b37a7..70aeac00d7f 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -1674,7 +1674,7 @@ Gnus might fail to display all of it.")
did-unpack))
(defun gnus-uu-dir-files (dir)
- (let ((dirs (directory-files dir t (rx (or (not ".") "..."))))
+ (let ((dirs (directory-files dir t directory-files-no-dot-files-regexp))
files file)
(while dirs
(if (file-directory-p (setq file (car dirs)))
@@ -1781,8 +1781,8 @@ Gnus might fail to display all of it.")
gnus-uu-tmp-dir)))
(setq gnus-uu-work-dir
- (make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir))
- (gnus-set-file-modes gnus-uu-work-dir 448)
+ (with-file-modes #o700
+ (make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)))
(setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir))
(push (cons gnus-newsgroup-name gnus-uu-work-dir)
gnus-uu-tmp-alist))))
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 36b28350362..baa3146e64e 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -142,7 +142,7 @@ used to display Gnus windows."
(pipe
(vertical 1.0
(summary 0.25 point)
- ("*Shell Command Output*" 1.0)))
+ (shell-command-buffer-name 1.0)))
(bug
(vertical 1.0
(if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 6df26b4af8c..c1cfddc87b3 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -292,6 +292,10 @@ is restarted, and sometimes reloaded."
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
+(defgroup gnus-dbus nil
+ "D-Bus integration for Gnus."
+ :group 'gnus)
+
(defconst gnus-version-number "5.13"
"Version number for this version of Gnus.")
@@ -660,7 +664,7 @@ be used directly.")
(defun gnus-add-buffer ()
"Add the current buffer to the list of Gnus buffers."
(gnus-prune-buffers)
- (push (current-buffer) gnus-buffers))
+ (cl-pushnew (current-buffer) gnus-buffers))
(defmacro gnus-kill-buffer (buffer)
"Kill BUFFER and remove from the list of Gnus buffers."
@@ -849,12 +853,6 @@ be used directly.")
(cons (car list) (list :type type :data data)))
list)))
-(let ((command (format "%s" this-command)))
- (when (string-match "gnus" command)
- (if (eq 'gnus-other-frame this-command)
- (gnus-get-buffer-create gnus-group-buffer)
- (gnus-splash))))
-
;;; Do the rest.
(require 'gnus-util)
@@ -1029,8 +1027,7 @@ Check the NNTPSERVER environment variable and the
;; `M-x customize-variable RET gnus-select-method RET' should work without
;; starting or even loading Gnus.
-;;;###autoload(when (fboundp 'custom-autoload)
-;;;###autoload (custom-autoload 'gnus-select-method "gnus"))
+;;;###autoload(custom-autoload 'gnus-select-method "gnus")
(defcustom gnus-select-method
(list 'nntp (or (gnus-getenv-nntpserver)
@@ -1591,7 +1588,7 @@ posting an article."
"Alist of group regexps and its initial input of the number of articles."
:variable-group gnus-group-parameter
:parameter-type '(choice :tag "Initial Input for Large Newsgroup"
- (const :tag "All" nil)
+ (const :tag "All" 'all)
(integer))
:parameter-document "\
@@ -1610,7 +1607,7 @@ total number of articles in the group.")
:variable-default (mapcar
(lambda (g) (list g t))
'("delayed$" "drafts$" "queue$" "INBOX$"
- "^nnmairix:" "^nnir:" "archive"))
+ "^nnmairix:" "^nnselect:" "archive"))
:variable-document
"Groups in which the registry should be turned off."
:variable-group gnus-registry
@@ -2226,8 +2223,8 @@ Disabling the agent may result in noticeable loss of performance."
:group 'gnus-start
:type '(choice (function-item gnus)
(function-item gnus-no-server)
- (function-item gnus-slave)
- (function-item gnus-slave-no-server)))
+ (function-item gnus-child)
+ (function-item gnus-child-no-server)))
(declare-function gnus-group-get-new-news "gnus-group")
@@ -2238,8 +2235,8 @@ Disabling the agent may result in noticeable loss of performance."
:type '(choice (function-item gnus)
(function-item gnus-group-get-new-news)
(function-item gnus-no-server)
- (function-item gnus-slave)
- (function-item gnus-slave-no-server)))
+ (function-item gnus-child)
+ (function-item gnus-child-no-server)))
(defcustom gnus-other-frame-parameters nil
"Frame parameters used by `gnus-other-frame' to create a Gnus frame."
@@ -2288,6 +2285,14 @@ a string, be sure to use a valid format, see RFC 2616."
(gnus-message 1 "Edit your init file to make this change permanent.")
(sit-for 2)))
+(defcustom gnus-agent-eagerly-store-articles t
+ "If non-nil, cache articles eagerly.
+
+When using the Gnus Agent and reading an agentized newsgroup,
+automatically cache the article in the agent cache."
+ :type 'boolean
+ :version "28.1")
+
;;; Internal variables
@@ -2417,8 +2422,8 @@ such as a mark that says whether an article is stored in the cache
(defvar gnus-article-buffer "*Article*")
(defvar gnus-server-buffer "*Server*")
-(defvar gnus-slave nil
- "Whether this Gnus is a slave or not.")
+(defvar gnus-child nil
+ "Whether this Gnus is a child or not.")
(defvar gnus-batch-mode nil
"Whether this Gnus is running in batch mode or not.")
@@ -2708,6 +2713,11 @@ with some simple extensions.
%k Pretty-printed version of the above (string)
For example, \"1.2k\" or \"0.4M\".
%L Number of lines in the article (integer)
+%Z RSV of the article; nil if not in an nnselect group (integer)
+%G Originating group name for the article; nil if not
+ in an nnselect group (string)
+%g Short from of the originating group name for the article;
+ nil if not in an nnselect group (string)
%I Indentation based on thread level (a string of
spaces)
%B A complex trn-style thread tree (string)
@@ -3156,7 +3166,10 @@ that that variable is buffer-local to the summary buffers."
(defun gnus-kill-ephemeral-group (group)
"Remove ephemeral GROUP from relevant structures."
- (remhash group gnus-newsrc-hashtb))
+ (remhash group gnus-newsrc-hashtb)
+ (setq gnus-newsrc-alist
+ (delq (assoc group gnus-newsrc-alist)
+ gnus-newsrc-alist)))
(defun gnus-simplify-mode-line ()
"Make mode lines a bit simpler."
@@ -3623,11 +3636,12 @@ If you call this function inside a loop, consider using the faster
(defun gnus-group-get-parameter (group &optional symbol allow-list)
"Return the group parameters for GROUP.
-If SYMBOL, return the value of that symbol in the group parameters.
-If ALLOW-LIST, also allow list as a result.
-Most functions should use `gnus-group-find-parameter', which
-also examines the topic parameters."
- (let ((params (gnus-info-params (gnus-get-info group))))
+If SYMBOL, return the value of that symbol in the group
+parameters. If ALLOW-LIST, also allow list as a result. Most
+functions should use `gnus-group-find-parameter', which also
+examines the topic parameters. GROUP can also be an info structure."
+ (let ((params (gnus-info-params (if (listp group) group
+ (gnus-get-info group)))))
(if symbol
(gnus-group-parameter-value params symbol allow-list)
params)))
@@ -4034,13 +4048,20 @@ Allow completion over sensible values."
;;; User-level commands.
;;;###autoload
+(defun gnus-child-no-server (&optional arg)
+ "Read network news as a child, without connecting to the local server."
+ (interactive "P")
+ (gnus-no-server arg t))
+
+;;;###autoload
(defun gnus-slave-no-server (&optional arg)
- "Read network news as a slave, without connecting to the local server."
+ "Read network news as a child, without connecting to the local server."
(interactive "P")
(gnus-no-server arg t))
+(make-obsolete 'gnus-slave-no-server 'gnus-child-no-server "28.1")
;;;###autoload
-(defun gnus-no-server (&optional arg slave)
+(defun gnus-no-server (&optional arg child)
"Read network news.
If ARG is a positive number, Gnus will use that as the startup level.
If ARG is nil, Gnus will be started at level 2. If ARG is non-nil
@@ -4049,13 +4070,20 @@ an NNTP server to use.
As opposed to `gnus', this command will not connect to the local
server."
(interactive "P")
- (gnus-no-server-1 arg slave))
+ (gnus-no-server-1 arg child))
+
+;;;###autoload
+(defun gnus-child (&optional arg)
+ "Read news as a child."
+ (interactive "P")
+ (gnus arg nil 'child))
;;;###autoload
(defun gnus-slave (&optional arg)
- "Read news as a slave."
+ "Read news as a child."
(interactive "P")
- (gnus arg nil 'slave))
+ (gnus arg nil 'child))
+(make-obsolete 'gnus-slave 'gnus-child "28.1")
(defun gnus-delete-gnus-frame ()
"Delete gnus frame unless it is the only one.
@@ -4116,7 +4144,7 @@ current display is used."
(add-hook 'gnus-suspend-gnus-hook #'gnus-delete-gnus-frame)))))
;;;###autoload
-(defun gnus (&optional arg dont-connect slave)
+(defun gnus (&optional arg dont-connect child)
"Read network news.
If ARG is non-nil and a positive number, Gnus will use that as the
startup level. If ARG is non-nil and not a positive number, Gnus will
@@ -4130,7 +4158,7 @@ prompt the user for the name of an NNTP server to use."
(message "You should byte-compile Gnus")
(sit-for 2))
(let ((gnus-action-message-log (list nil)))
- (gnus-1 arg dont-connect slave)
+ (gnus-1 arg dont-connect child)
(gnus-final-warning)))
(declare-function debbugs-gnu "ext:debbugs-gnu"
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el
index 218a1542e3a..485d58ad94e 100644
--- a/lisp/gnus/gssapi.el
+++ b/lisp/gnus/gssapi.el
@@ -25,8 +25,6 @@
;;; Code:
-(require 'format-spec)
-
(defcustom gssapi-program (list
(concat "gsasl %s %p "
"--mechanism GSSAPI "
@@ -53,12 +51,9 @@ tried until a successful connection is made."
(coding-system-for-write 'binary)
(process (start-process
name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?p (number-to-string port)
- ?l user))))
+ (format-spec cmd `((?s . ,server)
+ (?p . ,(number-to-string port))
+ (?l . ,user)))))
response)
(when process
(while (and (memq (process-status process) '(open run))
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 52343d4fa37..43180726c45 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -24,7 +24,6 @@
;;; Code:
-(require 'format-spec)
(eval-when-compile
(require 'cl-lib)
(require 'imap))
@@ -695,7 +694,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
mail-source-movemail-program
nil errors nil from to)))))
(when (file-exists-p to)
- (set-file-modes to mail-source-default-file-modes))
+ (set-file-modes to mail-source-default-file-modes 'nofollow))
(if (and (or (not (buffer-modified-p errors))
(zerop (buffer-size errors)))
(and (numberp result)
@@ -740,9 +739,11 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(when delay
(sleep-for delay)))
+(declare-function gnus-get-buffer-create "gnus" (name))
(defun mail-source-call-script (script)
+ (require 'gnus)
(let ((background nil)
- (stderr (get-buffer-create " *mail-source-stderr*"))
+ (stderr (gnus-get-buffer-create " *mail-source-stderr*"))
result)
(when (string-match "& *$" script)
(setq script (substring script 0 (match-beginning 0))
@@ -767,14 +768,14 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
"Fetcher for single-file sources."
(mail-source-bind (file source)
(mail-source-run-script
- prescript (format-spec-make ?t mail-source-crash-box)
+ prescript `((?t . ,mail-source-crash-box))
prescript-delay)
(let ((mail-source-string (format "file:%s" path)))
(if (mail-source-movemail path mail-source-crash-box)
(prog1
(mail-source-callback callback path)
(mail-source-run-script
- postscript (format-spec-make ?t mail-source-crash-box))
+ postscript `((?t . ,mail-source-crash-box)))
(mail-source-delete-crash-box))
0))))
@@ -782,7 +783,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
"Fetcher for directory sources."
(mail-source-bind (directory source)
(mail-source-run-script
- prescript (format-spec-make ?t path) prescript-delay)
+ prescript `((?t . ,path)) prescript-delay)
(let ((found 0)
(mail-source-string (format "directory:%s" path)))
(dolist (file (directory-files
@@ -791,7 +792,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(funcall predicate file)
(mail-source-movemail file mail-source-crash-box))
(cl-incf found (mail-source-callback callback file))
- (mail-source-run-script postscript (format-spec-make ?t path))
+ (mail-source-run-script postscript `((?t . ,path)))
(mail-source-delete-crash-box)))
found)))
@@ -801,8 +802,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
;; fixme: deal with stream type in format specs
(mail-source-run-script
prescript
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user)
+ `((?p . ,password) (?t . ,mail-source-crash-box)
+ (?s . ,server) (?P . ,port) (?u . ,user))
prescript-delay)
(let ((from (format "%s:%s:%s" server user port))
(mail-source-string (format "pop:%s@%s" user server))
@@ -823,8 +824,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(mail-source-fetch-with-program
(format-spec
program
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user))))
+ `((?p . ,password) (?t . ,mail-source-crash-box)
+ (?s . ,server) (?P . ,port) (?u . ,user)))))
(function
(funcall function mail-source-crash-box))
;; The default is to use pop3.el.
@@ -861,8 +862,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(setq mail-source-new-mail-available nil))
(mail-source-run-script
postscript
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user))
+ `((?p . ,password) (?t . ,mail-source-crash-box)
+ (?s . ,server) (?P . ,port) (?u . ,user)))
(mail-source-delete-crash-box)))
;; We nix out the password in case the error
;; was because of a wrong password being given.
@@ -1075,8 +1076,9 @@ This only works when `display-time' is enabled."
"Fetcher for imap sources."
(mail-source-bind (imap source)
(mail-source-run-script
- prescript (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user)
+ prescript
+ `((?p . ,password) (?t . ,mail-source-crash-box)
+ (?s . ,server) (?P . ,port) (?u . ,user))
prescript-delay)
(let ((from (format "%s:%s:%s" server user port))
(found 0)
@@ -1141,8 +1143,8 @@ This only works when `display-time' is enabled."
(kill-buffer buf)
(mail-source-run-script
postscript
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user))
+ `((?p . ,password) (?t . ,mail-source-crash-box)
+ (?s . ,server) (?P . ,port) (?u . ,user)))
found)))
(provide 'mail-source)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 6c425b0ea16..0782778fd43 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -42,13 +42,12 @@
(require 'mail-parse)
(require 'mml)
(require 'rfc822)
-(require 'format-spec)
(require 'dired)
(require 'mm-util)
(require 'rfc2047)
(require 'puny)
-(require 'rmc) ; read-multiple-choice
-(eval-when-compile (require 'subr-x)) ; when-let*
+(require 'rmc) ; read-multiple-choice
+(eval-when-compile (require 'subr-x))
(autoload 'mailclient-send-it "mailclient")
@@ -215,9 +214,9 @@ Also see `message-required-news-headers' and
:link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
-(defcustom message-draft-headers '(References From Date)
+(defcustom message-draft-headers '(References From)
"Headers to be generated when saving a draft message."
- :version "22.1"
+ :version "28.1"
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
@@ -304,6 +303,13 @@ any confusion."
:link '(custom-manual "(message)Message Headers")
:type 'regexp)
+(defcustom message-screenshot-command '("import" "png:-")
+ "Command to take a screenshot.
+The command should insert a PNG in the current buffer."
+ :group 'message-various
+ :type '(repeat string)
+ :version "28.1")
+
;;; Start of variables adopted from `message-utils.el'.
(defcustom message-subject-trailing-was-query t
@@ -322,7 +328,7 @@ used."
:group 'message-various)
(defcustom message-subject-trailing-was-ask-regexp
- "[ \t]*\\([[(]+[Ww][Aa][Ss]:?[ \t]*.*[])]+\\)"
+ "[ \t]*\\([[(]+[Ww][Aa][Ss].*[])]+\\)"
"Regexp matching \"(was: <old subject>)\" in the subject line.
The function `message-strip-subject-trailing-was' uses this regexp if
@@ -337,7 +343,7 @@ It is okay to create some false positives here, as the user is asked."
:type 'regexp)
(defcustom message-subject-trailing-was-regexp
- "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
+ "[ \t]*\\((*[Ww][Aa][Ss]:.*)\\)"
"Regexp matching \"(was: <old subject>)\" in the subject line.
If `message-subject-trailing-was-query' is set to t, the subject is
@@ -440,8 +446,8 @@ whitespace)."
(defcustom message-elide-ellipsis "\n[...]\n\n"
"The string which is inserted for elided text.
-This is a format-spec string, and you can use %l to say how many
-lines were removed, and %c to say how many characters were
+This is a `format-spec' string, and you can use %l to say how
+many lines were removed, and %c to say how many characters were
removed."
:type 'string
:link '(custom-manual "(message)Various Commands")
@@ -848,7 +854,8 @@ symbol `never', the posting is not allowed. If it is the symbol
;; differently (bug#36937).
nil
"Non-nil means don't add \"-f username\" to the sendmail command line.
-Doing so would be even more evil than leaving it out."
+See `feedmail-sendmail-f-doesnt-sell-me-out' for an explanation
+of what the \"-f\" parameter does."
:group 'message-sending
:link '(custom-manual "(message)Mail Variables")
:type 'boolean)
@@ -1099,7 +1106,8 @@ point and mark around the citation text as modified."
If nil, don't insert a signature.
If t, insert `message-signature-file'.
If a function or form, insert its result.
-See `mail-signature' for the recommended format of a signature."
+See `mail-signature' for the recommended format of a signature.
+Also see `message-signature-insert-empty-line'."
:version "23.2"
:type '(choice string
(const :tag "None" nil)
@@ -1986,6 +1994,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
(autoload 'gnus-delay-article "gnus-delay")
(autoload 'gnus-extract-address-components "gnus-util")
(autoload 'gnus-find-method-for-group "gnus")
+(autoload 'gnus-get-buffer-create "gnus")
(autoload 'gnus-group-name-charset "gnus-group")
(autoload 'gnus-group-name-decode "gnus-group")
(autoload 'gnus-groups-from-server "gnus")
@@ -2730,6 +2739,65 @@ systematically send encrypted emails when possible."
(when (message-all-epg-keys-available-p)
(mml-secure-message-sign-encrypt)))
+(defcustom message-openpgp-header nil
+ "Specification for the \"OpenPGP\" header of outgoing messages.
+
+The value must be a list of three elements, all strings:
+- Key ID, in hexadecimal form;
+- Key URL or ASCII armoured key; and
+- Protection preference, one of: \"unprotected\", \"sign\",
+ \"encrypt\" or \"signencrypt\".
+
+Each of the elements may be nil, in which case its part in the
+OpenPGP header will be left out. If all the values are nil,
+or `message-openpgp-header' is itself nil, the OpenPGP header
+will not be inserted."
+ :type '(choice
+ (const :tag "Don't add OpenPGP header" nil)
+ (list :tag "Use OpenPGP header"
+ (choice (string :tag "ID")
+ (const :tag "No ID" nil))
+ (choice (string :tag "Key")
+ (const :tag "No Key" nil))
+ (choice (other :tag "None" nil)
+ (const :tag "Unprotected" "unprotected")
+ (const :tag "Sign" "sign")
+ (const :tag "Encrypt" "encrypt")
+ (const :tag "Sign and Encrypt" "signencrypt"))))
+ :version "28.1")
+
+(defun message-add-openpgp-header ()
+ "Add OpenPGP header to point to public key.
+
+Header will be constructed as specified in `message-openpgp-header'.
+
+Consider adding this function to `message-header-setup-hook'"
+ ;; See https://tools.ietf.org/html/draft-josefsson-openpgp-mailnews-header
+ (when (and message-openpgp-header
+ (or (nth 0 message-openpgp-header)
+ (nth 1 message-openpgp-header)
+ (nth 2 message-openpgp-header)))
+ (message-add-header
+ (with-temp-buffer
+ (insert "OpenPGP: ")
+ ;; add ID
+ (let (need-sep)
+ (when (nth 0 message-openpgp-header)
+ (insert "id=" (nth 0 message-openpgp-header))
+ (setq need-sep t))
+ ;; add URL
+ (when (nth 1 message-openpgp-header)
+ (when need-sep (insert "; "))
+ (insert "url=\"" (nth 1 message-openpgp-header) "\"")
+ (setq need-sep t))
+ ;; add preference
+ (when (nth 2 message-openpgp-header)
+ (when need-sep (insert "; "))
+ (insert "preference=" (nth 2 message-openpgp-header))))
+ ;; insert header
+ (buffer-string)))
+ (message-sort-headers)))
+
;;;
@@ -2810,6 +2878,7 @@ systematically send encrypted emails when possible."
(define-key message-mode-map [remap split-line] 'message-split-line)
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
+ (define-key message-mode-map "\C-c\C-p" 'message-insert-screenshot)
(define-key message-mode-map "\C-a" 'message-beginning-of-line)
(define-key message-mode-map "\t" 'message-tab)
@@ -2839,6 +2908,8 @@ systematically send encrypted emails when possible."
:active (message-mark-active-p) :help "Mark region with enclosing tags"]
["Insert File Marked..." message-mark-insert-file
:help "Insert file at point marked with enclosing tags"]
+ ["Attach File..." mml-attach-file t]
+ ["Insert Screenshot" message-insert-screenshot t]
"----"
["Send Message" message-send-and-exit :help "Send this message"]
["Postpone Message" message-dont-send
@@ -3464,8 +3535,8 @@ Prefix arg means justify as well."
(equal quoted (match-string 0)))
(goto-char (match-end 0))
(looking-at "[ \t]*")
- (if (> (length leading-space) (length (match-string 0)))
- (setq leading-space (match-string 0)))
+ (when (< (length leading-space) (length (match-string 0)))
+ (setq leading-space (match-string 0)))
(forward-line 1))
(setq end (point))
(goto-char beg)
@@ -3542,7 +3613,14 @@ Message buffers and is not meant to be called directly."
(do-auto-fill))))
(defun message-insert-signature (&optional force)
- "Insert a signature. See documentation for variable `message-signature'."
+ "Insert a signature at the end of the buffer.
+
+See the documentation for the `message-signature' variable for
+more information.
+
+If FORCE is 0 (or when called interactively), the global values
+of the signature variables will be consulted if the local ones
+are null."
(interactive (list 0))
(let ((message-signature message-signature)
(message-signature-file message-signature-file))
@@ -3976,7 +4054,6 @@ This function uses `mail-citation-hook' if that is non-nil."
"Cite function in the standard Message manner."
(message-cite-original-1 nil))
-(autoload 'format-spec "format-spec")
(autoload 'gnus-date-get-time "gnus-util")
(defun message-insert-formatted-citation-line (&optional from date tz)
@@ -4001,20 +4078,18 @@ See `message-citation-line-format'."
(when (or message-reply-headers (and from date))
(unless from
(setq from (mail-header-from message-reply-headers)))
- (let* ((data (condition-case ()
- (funcall (if (boundp 'gnus-extract-address-components)
- gnus-extract-address-components
- 'mail-extract-address-components)
- from)
- (error nil)))
+ (let* ((data (ignore-errors
+ (funcall (or (bound-and-true-p
+ gnus-extract-address-components)
+ #'mail-extract-address-components)
+ from)))
(name (car data))
(fname name)
(lname name)
- (net (car (cdr data)))
- (name-or-net (or (car data)
- (car (cdr data)) from))
+ (net (cadr data))
+ (name-or-net (or name net from))
(time
- (when (string-match "%[^fnNFL]" message-citation-line-format)
+ (when (string-match-p "%[^FLNfn]" message-citation-line-format)
(cond ((numberp (car-safe date)) date) ;; backward compatibility
(date (gnus-date-get-time date))
(t
@@ -4023,68 +4098,53 @@ See `message-citation-line-format'."
(tz (or tz
(when (stringp date)
(nth 8 (parse-time-string date)))))
- (flist
- (let ((i ?A) lst)
- (when (stringp name)
- ;; Guess first name and last name:
- (let* ((names (delq
- nil
- (mapcar
- (lambda (x)
- (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'"
- x)
- x
- nil))
- (split-string name "[ \t]+"))))
- (count (length names)))
- (cond ((= count 1)
- (setq fname (car names)
- lname ""))
- ((or (= count 2) (= count 3))
- (setq fname (car names)
- lname (mapconcat 'identity (cdr names) " ")))
- ((> count 3)
- (setq fname (mapconcat 'identity
- (butlast names (- count 2))
- " ")
- lname (mapconcat 'identity
- (nthcdr 2 names)
- " "))))
- (when (string-match "\\(.*\\),\\'" fname)
- (let ((newlname (match-string 1 fname)))
- (setq fname lname lname newlname)))))
- ;; The following letters are not used in `format-time-string':
- (push ?E lst) (push "<E>" lst)
- (push ?F lst) (push (or fname name-or-net) lst)
- ;; We might want to use "" instead of "<X>" later.
- (push ?J lst) (push "<J>" lst)
- (push ?K lst) (push "<K>" lst)
- (push ?L lst) (push lname lst)
- (push ?N lst) (push name-or-net lst)
- (push ?O lst) (push "<O>" lst)
- (push ?P lst) (push "<P>" lst)
- (push ?Q lst) (push "<Q>" lst)
- (push ?f lst) (push from lst)
- (push ?i lst) (push "<i>" lst)
- (push ?n lst) (push net lst)
- (push ?o lst) (push "<o>" lst)
- (push ?q lst) (push "<q>" lst)
- (push ?t lst) (push "<t>" lst)
- (push ?v lst) (push "<v>" lst)
- ;; Delegate the rest to `format-time-string':
- (while (<= i ?z)
- (when (and (not (memq i lst))
- ;; Skip (Z,a)
- (or (<= i ?Z)
- (>= i ?a)))
- (push i lst)
- (push (condition-case nil
- (format-time-string (format "%%%c" i) time tz)
- (error (format ">%c<" i)))
- lst))
- (setq i (1+ i)))
- (reverse lst)))
- (spec (apply 'format-spec-make flist)))
+ spec)
+ (when (stringp name)
+ ;; Guess first name and last name:
+ (let* ((names (seq-filter
+ (lambda (s)
+ (string-match-p (rx bos (+ (in word ?. ?-)) eos) s))
+ (split-string name "[ \t]+")))
+ (count (length names)))
+ (cond ((= count 1)
+ (setq fname (car names)
+ lname ""))
+ ((or (= count 2) (= count 3))
+ (setq fname (car names)
+ lname (string-join (cdr names) " ")))
+ ((> count 3)
+ (setq fname (string-join (butlast names (- count 2))
+ " ")
+ lname (string-join (nthcdr 2 names) " "))))
+ (when (string-match "\\(.*\\),\\'" fname)
+ (let ((newlname (match-string 1 fname)))
+ (setq fname lname lname newlname)))))
+ ;; The following letters are not used in `format-time-string':
+ (push (cons ?E "<E>") spec)
+ (push (cons ?F (or fname name-or-net)) spec)
+ ;; We might want to use "" instead of "<X>" later.
+ (push (cons ?J "<J>") spec)
+ (push (cons ?K "<K>") spec)
+ (push (cons ?L lname) spec)
+ (push (cons ?N name-or-net) spec)
+ (push (cons ?O "<O>") spec)
+ (push (cons ?P "<P>") spec)
+ (push (cons ?Q "<Q>") spec)
+ (push (cons ?f from) spec)
+ (push (cons ?i "<i>") spec)
+ (push (cons ?n net) spec)
+ (push (cons ?o "<o>") spec)
+ (push (cons ?q "<q>") spec)
+ (push (cons ?t "<t>") spec)
+ (push (cons ?v "<v>") spec)
+ ;; Delegate the rest to `format-time-string':
+ (dolist (c (nconc (number-sequence ?A ?Z)
+ (number-sequence ?a ?z)))
+ (unless (assq c spec)
+ (push (cons c (condition-case nil
+ (format-time-string (format "%%%c" c) time tz)
+ (error (format ">%c<" c))))
+ spec)))
(insert (format-spec message-citation-line-format spec)))
(newline)))
@@ -4376,7 +4436,7 @@ conformance."
(error "Invisible text found and made visible")))))
(message-check 'illegible-text
(let (char found choice nul-chars)
- (message-goto-body)
+ (goto-char (point-min))
(setq nul-chars (save-excursion
(search-forward "\000" nil t)))
(while (progn
@@ -4412,11 +4472,12 @@ conformance."
,(format
"Replace non-printable characters with \"%s\" and send"
message-replacement-char))
+ (?u "url-encode" "Use URL %hex encoding")
(?s "send" "Send as is without removing anything")
(?e "edit" "Continue editing")))))
(if (eq choice ?e)
(error "Non-printable characters"))
- (message-goto-body)
+ (goto-char (point-min))
(skip-chars-forward mm-7bit-chars)
(while (not (eobp))
(when (let ((char (char-after)))
@@ -4433,11 +4494,17 @@ conformance."
control-1))
(not (get-text-property
(point) 'untranslated-utf-8)))))
- (if (eq choice ?i)
- (message-kill-all-overlays)
+ (cond
+ ((eq choice ?i)
+ (message-kill-all-overlays))
+ ((eq choice ?u)
+ (let ((char (get-byte (point))))
+ (delete-char 1)
+ (insert (format "%%%x" char))))
+ (t
(delete-char 1)
(when (eq choice ?r)
- (insert message-replacement-char))))
+ (insert message-replacement-char)))))
(forward-char)
(skip-chars-forward mm-7bit-chars)))))
(message-check 'bogus-recipient
@@ -4507,7 +4574,8 @@ This function could be useful in `message-setup-hook'."
(custom-add-option 'message-setup-hook 'message-check-recipients)
(defun message-add-action (action &rest types)
- "Add ACTION to be performed when doing an exit of type TYPES."
+ "Add ACTION to be performed when doing an exit of type TYPES.
+Valid types are `send', `return', `exit', `kill' and `postpone'."
(while types
(add-to-list (intern (format "message-%s-actions" (pop types)))
action)))
@@ -4757,7 +4825,7 @@ If you always want Gnus to send messages in one piece, set
message-courtesy-message)))
;; If this was set, `sendmail-program' takes care of encoding.
(unless message-inhibit-body-encoding
- ;; Let's make sure we encoded all the body.
+ ;; Let's make sure we encoded everything in the buffer.
(cl-assert (save-excursion
(goto-char (point-min))
(not (re-search-forward "[^\000-\377]" nil t)))))
@@ -4782,15 +4850,16 @@ If you always want Gnus to send messages in one piece, set
Each line should be no more than 79 characters long."
(goto-char (point-min))
(while (not (eobp))
- (when (and (looking-at "[^:]+:")
- (> (- (line-end-position) (point)) 79))
- (mail-header-fold-field))
- (forward-line 1)))
+ (if (and (looking-at "[^:]+:")
+ (> (- (line-end-position) (point)) 79))
+ (goto-char (mail-header-fold-field))
+ (forward-line 1))))
(defvar sendmail-program)
(defvar smtpmail-smtp-server)
(defvar smtpmail-smtp-service)
(defvar smtpmail-smtp-user)
+(defvar smtpmail-stream-type)
(defun message-multi-smtp-send-mail ()
"Send the current buffer to `message-send-mail-function'.
@@ -4809,6 +4878,11 @@ that instead."
(let* ((smtpmail-smtp-server (nth 1 method))
(service (nth 2 method))
(port (string-to-number service))
+ ;; If we're talking to the TLS SMTP port, then force a
+ ;; TLS connection.
+ (smtpmail-stream-type (if (= port 465)
+ 'tls
+ smtpmail-stream-type))
(smtpmail-smtp-service (if (> port 0) port service))
(smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user)))
(message-smtpmail-send-it)))
@@ -5591,7 +5665,7 @@ The result is a fixnum."
(mail-file-babyl-p filename))
;; gnus-output-to-mail does the wrong thing with live, mbox
;; Rmail buffers in Emacs 23.
- ;; http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=597255
+ ;; https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=597255
(let ((buff (find-buffer-visiting filename)))
(and buff (with-current-buffer buff
(eq major-mode 'rmail-mode)))))
@@ -6443,7 +6517,7 @@ When called without a prefix argument, header value spanning
multiple lines is treated as a single line. Otherwise, even if
N is 1, when point is on a continuation header line, it will be
moved to the beginning "
- (interactive "p")
+ (interactive "^p")
(cond
;; Go to beginning of header or beginning of line.
((and message-beginning-of-line (message-point-in-header-p))
@@ -7006,15 +7080,28 @@ want to get rid of this query permanently.")))
;; Build the header alist. Allow the user to be asked whether
;; or not to reply to all recipients in a wide reply.
- (setq follow-to (list (cons 'To (cdr (pop recipients)))))
- (when (and recipients
- (or (not message-wide-reply-confirm-recipients)
- (y-or-n-p "Reply to all recipients? ")))
- (setq recipients (mapconcat
- (lambda (addr) (cdr addr)) recipients ", "))
- (if (string-match "^ +" recipients)
- (setq recipients (substring recipients (match-end 0))))
- (push (cons 'Cc recipients) follow-to)))
+ (when (or (< (length recipients) 2)
+ (not message-wide-reply-confirm-recipients)
+ (y-or-n-p "Reply to all recipients? "))
+ (if never-mct
+ ;; The author has requested never to get a (wide)
+ ;; response, so put everybody else into the To header.
+ ;; This avoids looking as if we're To-in somebody else in
+ ;; specific, and just Cc-in the rest.
+ (setq follow-to (list
+ (cons 'To
+ (mapconcat
+ (lambda (addr)
+ (cdr addr)) recipients ", "))))
+ ;; Put the first recipient in the To header.
+ (setq follow-to (list (cons 'To (cdr (pop recipients)))))
+ ;; Put the rest of the recipients in Cc.
+ (when recipients
+ (setq recipients (mapconcat
+ (lambda (addr) (cdr addr)) recipients ", "))
+ (if (string-match "^ +" recipients)
+ (setq recipients (substring recipients (match-end 0))))
+ (push (cons 'Cc recipients) follow-to)))))
follow-to))
(defun message-prune-recipients (recipients)
@@ -7310,7 +7397,7 @@ If ARG, allow editing of the cancellation message."
;; Make control message.
(if arg
(message-news)
- (setq buf (set-buffer (get-buffer-create " *message cancel*"))))
+ (setq buf (set-buffer (gnus-get-buffer-create " *message cancel*"))))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
"From: " from "\n"
@@ -7731,7 +7818,7 @@ is for the internal use."
gcc beg)
;; We first set up a normal mail buffer.
(unless (message-mail-user-agent)
- (set-buffer (get-buffer-create " *message resend*"))
+ (set-buffer (gnus-get-buffer-create " *message resend*"))
(let ((inhibit-read-only t))
(erase-buffer)))
(let ((message-this-is-mail t)
@@ -7983,7 +8070,7 @@ See `gmm-tool-bar-from-list' for details on the format of the list."
(defcustom message-tool-bar-retro
'(;; Old Emacs 21 icon for consistency.
- (message-send-and-exit "gnus/mail-send")
+ (message-send-and-exit "mail/send")
(message-kill-buffer "close")
(message-dont-send "cancel")
(mml-attach-file "attach" mml-mode-map)
@@ -8510,7 +8597,7 @@ Meant for use on `completion-at-point-functions'."
;; FIXME: What is the most common term (circular letter, form letter, serial
;; letter, standard letter) for such kind of letter? See also
-;; <http://en.wikipedia.org/wiki/Form_letter>
+;; <https://en.wikipedia.org/wiki/Form_letter>
;; FIXME: Maybe extent message-mode's font-lock support to recognize
;; `message-form-letter-separator', i.e. highlight each message like a single
@@ -8670,8 +8757,112 @@ Used in `message-simplify-recipients'."
(* 0.5 (- (nth 3 edges) (nth 1 edges)))))
string)))))))
+(defun message-insert-screenshot (delay)
+ "Take a screenshot and insert in the current buffer.
+DELAY (the numeric prefix) says how many seconds to wait before
+starting the screenshotting process.
+
+The `message-screenshot-command' variable says what command is
+used to take the screenshot."
+ (interactive "p")
+ (unless (executable-find (car message-screenshot-command))
+ (error "Can't find %s to take the screenshot"
+ (car message-screenshot-command)))
+ (cl-decf delay)
+ (unless (zerop delay)
+ (dotimes (i delay)
+ (message "Sleeping %d second%s..."
+ (- delay i)
+ (if (= (- delay i) 1)
+ ""
+ "s"))
+ (sleep-for 1)))
+ (message "Take screenshot")
+ (let ((image
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (apply #'call-process
+ (car message-screenshot-command) nil (current-buffer) nil
+ (cdr message-screenshot-command))
+ (buffer-string))))
+ (set-mark (point))
+ (insert-image
+ (create-image image 'png t
+ :max-width (truncate (* (frame-pixel-width) 0.8))
+ :max-height (truncate (* (frame-pixel-height) 0.8))
+ :scale 1)
+ (format "<#part type=\"image/png\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>"
+ ;; Get a base64 version of the image -- this avoids later
+ ;; complications if we're auto-saving the buffer and
+ ;; restoring from a file.
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert image)
+ (base64-encode-region (point-min) (point-max) t)
+ (buffer-string))))
+ (insert "\n\n")
+ (message "")))
+
+(declare-function gnus-url-unhex-string "gnus-util")
+
+(defun message-parse-mailto-url (url)
+ "Parse a mailto: url."
+ (setq url (replace-regexp-in-string "\n" " " url))
+ (when (string-match "mailto:/*\\(.*\\)" url)
+ (setq url (substring url (match-beginning 1) nil)))
+ (setq url (if (string-match "^\\?" url)
+ (substring url 1)
+ (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
+ (concat "to=" (match-string 1 url) "&"
+ (match-string 2 url))
+ (concat "to=" url))))
+ (let (retval pairs cur key val)
+ (setq pairs (split-string url "&"))
+ (while pairs
+ (setq cur (car pairs)
+ pairs (cdr pairs))
+ (if (not (string-match "=" cur))
+ nil ; Grace
+ (setq key (downcase (gnus-url-unhex-string
+ (substring cur 0 (match-beginning 0))))
+ val (gnus-url-unhex-string (substring cur (match-end 0) nil) t))
+ (setq cur (assoc key retval))
+ (if cur
+ (setcdr cur (cons val (cdr cur)))
+ (setq retval (cons (list key val) retval)))))
+ retval))
+
+;;;###autoload
+(defun message-mailto ()
+ "Command to parse command line mailto: links.
+This is meant to be used for MIME handlers: Setting the handler
+for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\"
+will then start up Emacs ready to compose mail."
+ (interactive)
+ ;; <a href="mailto:someone@example.com?subject=This%20is%20the%20subject&cc=someone_else@example.com&body=This%20is%20the%20body">Send email</a>
+ (message-mail)
+ (message-mailto-1 (pop command-line-args-left)))
+
+(defun message-mailto-1 (url)
+ (let ((args (message-parse-mailto-url url)))
+ (dolist (arg args)
+ (unless (equal (car arg) "body")
+ (message-position-on-field (capitalize (car arg)))
+ (insert (replace-regexp-in-string
+ "\r\n" "\n"
+ (mapconcat #'identity (reverse (cdr arg)) ", ") nil t))))
+ (when (assoc "body" args)
+ (message-goto-body)
+ (dolist (body (cdr (assoc "body" args)))
+ (insert body "\n")))
+ (if (assoc "subject" args)
+ (message-goto-body)
+ (message-goto-subject))))
+
(provide 'message)
+(make-obsolete-variable 'message-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'message-load-hook)
;; Local Variables:
diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el
index 6b4308e9790..56253afa193 100644
--- a/lisp/gnus/mm-archive.el
+++ b/lisp/gnus/mm-archive.el
@@ -24,6 +24,7 @@
(require 'mm-decode)
(autoload 'gnus-recursive-directory-files "gnus-util")
+(autoload 'gnus-get-buffer-create "gnus")
(autoload 'mailcap-extension-to-mime "mailcap")
(defvar mm-archive-decoders
@@ -41,8 +42,9 @@
dir)
(unless decoder
(error "No decoder found for %s" type))
- (setq dir (make-temp-file (expand-file-name "emm." mm-tmp-directory) 'dir))
- (set-file-modes dir #o700)
+ (with-file-modes #o700
+ (setq dir (make-temp-file (expand-file-name "emm." mm-tmp-directory)
+ 'dir)))
(unwind-protect
(progn
(mm-with-unibyte-buffer
@@ -56,7 +58,7 @@
(append (cdr decoder) (list dir)))
(delete-file file))
(apply 'call-process-region (point-min) (point-max) (car decoder)
- nil (get-buffer-create "*tnef*")
+ nil (gnus-get-buffer-create "*tnef*")
nil (append (cdr decoder) (list dir)))))
`("multipart/mixed"
,handle
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index a340418507f..1bce6ca020e 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -602,11 +602,10 @@ files left at the next time."
(push temp fails)))
(if fails
;; Schedule the deletion of the files left at the next time.
- (progn
+ (with-file-modes #o600
(write-region (concat (mapconcat 'identity (nreverse fails) "\n")
"\n")
- nil cache-file nil 'silent)
- (set-file-modes cache-file #o600))
+ nil cache-file nil 'silent))
(when (file-exists-p cache-file)
(ignore-errors (delete-file cache-file))))
(setq mm-temp-files-to-be-deleted nil)))
@@ -911,8 +910,10 @@ external if displayed external."
;; The function is a string to be executed.
(mm-insert-part handle)
(mm-add-meta-html-tag handle)
- (let* ((dir (make-temp-file
- (expand-file-name "emm." mm-tmp-directory) 'dir))
+ ;; We create a private sub-directory where we store our files.
+ (let* ((dir (with-file-modes #o700
+ (make-temp-file
+ (expand-file-name "emm." mm-tmp-directory) 'dir)))
(filename (or
(mail-content-type-get
(mm-handle-disposition handle) 'filename)
@@ -924,8 +925,6 @@ external if displayed external."
(assoc "needsterminal" mime-info)))
(copiousoutput (assoc "copiousoutput" mime-info))
file buffer)
- ;; We create a private sub-directory where we store our files.
- (set-file-modes dir #o700)
(if filename
(setq file (expand-file-name
(gnus-map-function mm-file-name-rewrite-functions
@@ -941,14 +940,15 @@ external if displayed external."
;; `mailcap-mime-extensions'.
(setq suffix (car (rassoc (mm-handle-media-type handle)
mailcap-mime-extensions))))
- (setq file (make-temp-file (expand-file-name "mm." dir)
- nil suffix))))
+ (setq file (with-file-modes #o600
+ (make-temp-file (expand-file-name "mm." dir)
+ nil suffix)))))
(let ((coding-system-for-write mm-binary-coding-system))
(write-region (point-min) (point-max) file nil 'nomesg))
;; The file is deleted after the viewer exists. If the users edits
;; the file, changes will be lost. Set file to read-only to make it
;; clear.
- (set-file-modes file #o400)
+ (set-file-modes file #o400 'nofollow)
(message "Viewing with %s" method)
(cond
(needsterm
@@ -1364,10 +1364,7 @@ PROMPT overrides the default one used to ask user for a file name."
(setq file
(read-file-name
(or prompt
- (format "Save MIME part to%s: "
- (if filename
- (format " (default %s)" filename)
- "")))
+ (format-prompt "Save MIME part to" filename))
(or directory mm-default-directory default-directory)
(expand-file-name
(or filename "")
@@ -1668,18 +1665,26 @@ If RECURSIVE, search recursively."
(let ((type (car ctl))
(subtype (cadr (split-string (car ctl) "/")))
(mm-security-handle ctl) ;; (car CTL) is the type.
+ (smime-type (cdr (assq 'smime-type (mm-handle-type parts))))
protocol func functest)
(cond
((or (equal type "application/x-pkcs7-mime")
(equal type "application/pkcs7-mime"))
(with-temp-buffer
(when (and (cond
+ ((equal smime-type "signed-data") t)
((eq mm-decrypt-option 'never) nil)
((eq mm-decrypt-option 'always) t)
((eq mm-decrypt-option 'known) t)
(t (y-or-n-p
(format "Decrypt (S/MIME) part? "))))
(mm-view-pkcs7 parts from))
+ (goto-char (point-min))
+ ;; The encrypted document is a MIME part, and may use either
+ ;; CRLF (Outlook and the like) or newlines for end-of-line
+ ;; markers. Translate from CRLF.
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
;; Normally there will be a Content-type header here, but
;; some mailers don't add that to the encrypted part, which
;; makes the subsequent re-dissection fail here.
@@ -1688,7 +1693,21 @@ If RECURSIVE, search recursively."
(unless (mail-fetch-field "content-type")
(goto-char (point-max))
(insert "Content-type: text/plain\n\n")))
- (setq parts (mm-dissect-buffer t)))))
+ (setq parts
+ (if (equal smime-type "signed-data")
+ (list (propertize
+ "multipart/signed"
+ 'protocol "application/pkcs7-signature"
+ 'gnus-info
+ (format
+ "%s:%s"
+ (get-text-property 0 'gnus-info
+ (car mm-security-handle))
+ (get-text-property 0 'gnus-details
+ (car mm-security-handle))))
+ (mm-dissect-buffer t)
+ parts)
+ (mm-dissect-buffer t))))))
((equal subtype "signed")
(unless (and (setq protocol
(mm-handle-multipart-ctl-parameter ctl 'protocol))
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 7629d5cb151..958e24c39f5 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -70,7 +70,7 @@
(mm-coding-system-p 'cp932))
'((windows-31j . cp932)))
;; Charset name: GBK, Charset aliases: CP936, MS936, windows-936
- ;; http://www.iana.org/assignments/charset-reg/GBK
+ ;; https://www.iana.org/assignments/charset-reg/GBK
;; Emacs 22.1 has cp936, but not gbk, so we alias it:
,@(when (and (not (mm-coding-system-p 'gbk))
(mm-coding-system-p 'cp936))
@@ -131,10 +131,6 @@ is not available."
(cond
((null charset)
charset)
- ;; Running in a non-MULE environment.
- ((or (null (mm-get-coding-system-list))
- (not (fboundp 'coding-system-get)))
- charset)
;; Check override list quite early. Should only used for decoding, not for
;; encoding!
((and allow-override
@@ -295,77 +291,16 @@ superset of iso-8859-1."
(defvar mm-universal-coding-system mm-auto-save-coding-system
"The universal coding system.")
-;; Fixme: some of the cars here aren't valid MIME charsets. That
-;; should only matter with XEmacs, though.
(defvar mm-mime-mule-charset-alist
- '((us-ascii ascii)
- (iso-8859-1 latin-iso8859-1)
- (iso-8859-2 latin-iso8859-2)
- (iso-8859-3 latin-iso8859-3)
- (iso-8859-4 latin-iso8859-4)
- (iso-8859-5 cyrillic-iso8859-5)
- ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters.
- ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default
- ;; charset is koi8-r, not iso-8859-5.
- (koi8-r cyrillic-iso8859-5 gnus-koi8-r)
- (iso-8859-6 arabic-iso8859-6)
- (iso-8859-7 greek-iso8859-7)
- (iso-8859-8 hebrew-iso8859-8)
- (iso-8859-9 latin-iso8859-9)
- (iso-8859-14 latin-iso8859-14)
- (iso-8859-15 latin-iso8859-15)
- (viscii vietnamese-viscii-lower)
- (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
- (euc-kr korean-ksc5601)
- (gb2312 chinese-gb2312)
- (gbk chinese-gbk)
- (gb18030 gb18030-2-byte
- gb18030-4-byte-bmp gb18030-4-byte-smp
- gb18030-4-byte-ext-1 gb18030-4-byte-ext-2)
- (big5 chinese-big5-1 chinese-big5-2)
- (tibetan tibetan)
- (thai-tis620 thai-tis620)
- (windows-1251 cyrillic-iso8859-5)
- (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
- (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212)
- (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2)
- (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
- cyrillic-iso8859-5 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2
- chinese-cns11643-3 chinese-cns11643-4
- chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7)
- (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
- japanese-jisx0213-1 japanese-jisx0213-2)
- (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)
- (utf-8))
- "Alist of MIME-charset/MULE-charsets.")
-
-;; Correct by construction, but should be unnecessary for Emacs:
-(when (and (fboundp 'coding-system-list)
- (fboundp 'sort-coding-systems))
- (let ((css (sort-coding-systems (coding-system-list 'base-only)))
- cs mime mule alist)
- (while css
- (setq cs (pop css)
- mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode)
- (coding-system-get cs 'mime-charset)))
+ (let (mime mule alist)
+ (dolist (cs (sort-coding-systems (coding-system-list 'base-only)))
+ (setq mime (coding-system-get cs 'mime-charset))
(when (and mime
- (not (eq t (setq mule
- (coding-system-get cs 'safe-charsets))))
+ (not (eq t (setq mule (coding-system-get cs 'safe-charsets))))
(not (assq mime alist)))
(push (cons mime (delq 'ascii mule)) alist)))
- (setq mm-mime-mule-charset-alist (nreverse alist))))
+ (nreverse alist))
+ "Alist of MIME-charset/MULE-charsets.")
(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
"A list of special charsets.
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index e6fdc93da24..aedd6c948c2 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -192,7 +192,7 @@ This can be either \"inline\" or \"attachment\".")
,(lambda () (mm-uu-verbatim-marks-extract 0 0))
nil)
(LaTeX
- "^\\([\\\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]"
+ "^\\([\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]"
"^\\\\end{document}"
,#'mm-uu-latex-extract
nil
@@ -251,19 +251,23 @@ The value should be nil on displays where the face
(((type tty)
(class color)
(background dark))
- (:background "dark blue"))
+ (:background "dark blue"
+ :extend t))
(((class color)
(background dark))
(:foreground "light yellow"
- :background "dark green"))
+ :background "dark green"
+ :extend t))
(((type tty)
(class color)
(background light))
- (:foreground "dark blue"))
+ (:foreground "dark blue"
+ :extend t))
(((class color)
(background light))
(:foreground "dark green"
- :background "light yellow"))
+ :background "light yellow"
+ :extend t))
(t
()))
"Face for extracted buffers."
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 828ac633dc5..ca610010917 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -59,11 +59,16 @@
"The attributes of renderer types for text/html.")
(defcustom mm-fill-flowed t
- "If non-nil a format=flowed article will be displayed flowed."
+ "If non-nil, format=flowed articles will be displayed flowed."
:type 'boolean
:version "22.1"
:group 'mime-display)
+;; Not a defcustom, since it's usually overridden by the callers of
+;; the mm functions.
+(defvar mm-inline-font-lock t
+ "If non-nil, do font locking of inline media types that support it.")
+
(defcustom mm-inline-large-images-proportion 0.9
"Maximum proportion large images can occupy in the buffer.
This is only used if `mm-inline-large-images' is set to
@@ -502,7 +507,8 @@ If MODE is not set, try to find mode automatically."
(delay-mode-hooks (set-auto-mode))
(setq mode major-mode)))
;; Do not fontify if the guess mode is fundamental.
- (unless (eq major-mode 'fundamental-mode)
+ (when (and (not (eq major-mode 'fundamental-mode))
+ mm-inline-font-lock)
(font-lock-ensure))))
(setq text (buffer-string))
(when (eq mode 'diff-mode)
@@ -540,7 +546,7 @@ If MODE is not set, try to find mode automatically."
(mm-display-inline-fontify handle 'shell-script-mode))
(defun mm-display-javascript-inline (handle)
- "Show JavsScript code from HANDLE inline."
+ "Show JavaScript code from HANDLE inline."
(mm-display-inline-fontify handle 'javascript-mode))
;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
@@ -591,8 +597,16 @@ If MODE is not set, try to find mode automatically."
(with-temp-buffer
(insert-buffer-substring (mm-handle-buffer handle))
(goto-char (point-min))
- (let ((part (base64-decode-string (buffer-string))))
- (epg-verify-string (epg-make-context 'CMS) part))))
+ (let ((part (base64-decode-string (buffer-string)))
+ (context (epg-make-context 'CMS)))
+ (prog1
+ (epg-verify-string context part)
+ (let ((result (car (epg-context-result-for context 'verify))))
+ (mm-sec-status
+ 'gnus-info (epg-signature-status result)
+ 'gnus-details
+ (format "%s:%s" (epg-signature-validity result)
+ (epg-signature-key-id result))))))))
(with-temp-buffer
(insert "MIME-Version: 1.0\n")
(mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 8d77916e997..74af99da7e3 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -665,8 +665,9 @@ The passphrase is read and cached."
(epg-user-id-string uid))))
(equal (downcase (car (mail-header-parse-address
(epg-user-id-string uid))))
- (downcase (car (mail-header-parse-address
- recipient))))
+ (downcase (or (car (mail-header-parse-address
+ recipient))
+ recipient)))
(not (memq (epg-user-id-validity uid)
'(revoked expired))))
(throw 'break t))))))
@@ -937,6 +938,48 @@ If no one is selected, symmetric encryption will be performed. "
(signal (car error) (cdr error))))
cipher))
+(defun mml-secure-sender-sign-query (protocol sender)
+ "Query whether to use SENDER to sign when using PROTOCOL.
+PROTOCOL will be `OpenPGP' or `CMS' (smime).
+This can also save the resulting value of
+`mml-secure-smime-sign-with-sender' or
+`mml-secure-openpgp-sign-with-sender' via Customize.
+Returns non-nil if the user has chosen to use SENDER."
+ (let ((buffer (get-buffer-create "*MML sender signing options*"))
+ (options '((?a "always" "Sign using this sender now and sign with message sender in future.")
+ (?s "session only" "Sign using this sender now, and sign with message sender for this session only.")
+ (?n "no" "Do not sign this message (and error out)")))
+ answer done val)
+ (save-window-excursion
+ (pop-to-buffer buffer)
+ (erase-buffer)
+ (insert (format "No %s signing key was found for this message.\nThe sender of this message is \"%s\".\nWould you like to attempt looking up a signing key based on it?"
+ (if (eq protocol 'OpenPGP)
+ "openpgp" "smime")
+ sender))
+ (while (not done)
+ (setq answer (read-multiple-choice "Sign this message using the sender?" options))
+ (cl-case (car answer)
+ (?a
+ (if (eq protocol 'OpenPGP)
+ (progn
+ (setq mml-secure-openpgp-sign-with-sender t)
+ (customize-save-variable
+ 'mml-secure-openpgp-sign-with-sender t))
+ (setq mml-secure-smime-sign-with-sender t)
+ (customize-save-variable 'mml-secure-smime-sign-with-sender t))
+ (setq done t
+ val t))
+ (?s
+ (if (eq protocol 'OpenPGP)
+ (setq mml-secure-openpgp-sign-with-sender t)
+ (setq mml-secure-smime-sign-with-sender t))
+ (setq done t
+ val t))
+ (?n
+ (setq done t)))))
+ val))
+
(defun mml-secure-epg-sign (protocol mode)
;; Based on code appearing inside mml2015-epg-sign.
(let* ((context (epg-make-context protocol))
@@ -944,6 +987,23 @@ If no one is selected, symmetric encryption will be performed. "
(signer-names (mml-secure-signer-names protocol sender))
(signers (mml-secure-signers context signer-names))
signature micalg)
+ (unless signers
+ (if (and (not noninteractive)
+ (mml-secure-sender-sign-query protocol sender))
+ (setq signer-names (mml-secure-signer-names protocol sender)
+ signers (mml-secure-signers context signer-names)))
+ (unless signers
+ (let ((maybe-msg
+ (if (or mml-secure-smime-sign-with-sender
+ mml-secure-openpgp-sign-with-sender)
+ "."
+ "; try setting `mml-secure-smime-sign-with-sender' or 'mml-secure-openpgp-sign-with-sender'.")))
+ ;; If `mml-secure-smime-sign-with-sender' or
+ ;; `mml-secure-openpgp-sign-with-sender' are already non-nil
+ ;; then there's no point advising the user to examine them.
+ ;; If there are any other variables worth examining, please
+ ;; improve this error message by having it mention them.
+ (error "Couldn't find any signer names%s" maybe-msg))))
(when (eq 'OpenPGP protocol)
(setf (epg-context-armor context) t)
(setf (epg-context-textmode context) t)
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 3cc463d5d4c..acddb300339 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -154,14 +154,9 @@ Whether the passphrase is cached at all is controlled by
(write-region (point-min) (point-max) file))
(push file certfiles)
(push file tmpfiles)))
- (if (smime-encrypt-buffer certfiles)
- (progn
- (while (setq tmp (pop tmpfiles))
- (delete-file tmp))
- t)
- (while (setq tmp (pop tmpfiles))
- (delete-file tmp))
- nil))
+ (smime-encrypt-buffer certfiles)
+ (while (setq tmp (pop tmpfiles))
+ (delete-file tmp)))
(goto-char (point-max)))
(defvar gnus-extract-address-components)
@@ -334,7 +329,6 @@ Whether the passphrase is cached at all is controlled by
(autoload 'epg-verify-string "epg")
(autoload 'epg-sign-string "epg")
(autoload 'epg-encrypt-string "epg")
- (autoload 'epg-passphrase-callback-function "epg")
(autoload 'epg-context-set-passphrase-callback "epg")
(autoload 'epg-sub-key-fingerprint "epg")
(autoload 'epg-configuration "epg-config")
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 556cf0804a5..067396fc2a6 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -295,6 +295,17 @@ part. This is for the internal use, you should never modify the value.")
(t
(mm-find-mime-charset-region point (point)
mm-hack-charsets))))
+ ;; We have a part that already has a transfer encoding. Undo
+ ;; that so that we don't double-encode later.
+ (when (and raw
+ (cdr (assq 'data-encoding tag)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert contents)
+ (mm-decode-content-transfer-encoding
+ (intern (cdr (assq 'data-encoding tag)))
+ (cdr (assq 'type tag)))
+ (setq contents (buffer-string))))
(when (and (not raw) (memq nil charsets))
(if (or (memq 'unknown-encoding mml-confirmation-set)
(message-options-get 'unknown-encoding)
@@ -313,8 +324,8 @@ Message contains characters with unknown encoding. Really send? ")
(eq 'mml (car tag))
(< (length charsets) 2))
(if (or (not no-markup-p)
+ ;; Don't create blank parts.
(string-match "[^ \t\r\n]" contents))
- ;; Don't create blank parts.
(push (nconc tag (list (cons 'contents contents)))
struct))
(let ((nstruct (mml-parse-singlepart-with-multiple-charsets
@@ -487,11 +498,8 @@ type detected."
(= (length cont) 1)
content-type)
(setcdr (assq 'type (cdr (car cont))) content-type))
- (when (and (consp (car cont))
- (= (length cont) 1)
- (fboundp 'libxml-parse-html-region)
- (equal (cdr (assq 'type (car cont))) "text/html"))
- (setq cont (mml-expand-html-into-multipart-related (car cont))))
+ (when (fboundp 'libxml-parse-html-region)
+ (setq cont (mapcar 'mml-expand-all-html-into-multipart-related cont)))
(prog1
(with-temp-buffer
(set-buffer-multibyte nil)
@@ -510,6 +518,18 @@ type detected."
(buffer-string))
(setq message-options options)))))
+(defun mml-expand-all-html-into-multipart-related (cont)
+ (cond ((and (eq (car cont) 'part)
+ (equal (cdr (assq 'type cont)) "text/html"))
+ (mml-expand-html-into-multipart-related cont))
+ ((eq (car cont) 'multipart)
+ (let ((cur (cdr cont)))
+ (while (consp cur)
+ (setcar cur (mml-expand-all-html-into-multipart-related (car cur)))
+ (setf cur (cdr cur))))
+ cont)
+ (t cont)))
+
(defun mml-expand-html-into-multipart-related (cont)
(let ((new-parts nil)
(cid 1))
@@ -538,8 +558,7 @@ type detected."
new-parts))
(setq cid (1+ cid)))))))
;; We have local images that we want to include.
- (if (not new-parts)
- (list cont)
+ (when new-parts
(setcdr (assq 'contents cont) (buffer-string))
(setq cont
(nconc (list 'multipart (cons 'type "related"))
@@ -552,8 +571,8 @@ type detected."
(nth 1 new-part)
(nth 2 new-part))
(id . ,(concat "<" (nth 0 new-part)
- ">")))))))
- cont))))
+ ">"))))))))
+ cont)))
(autoload 'image-property "image")
@@ -1341,7 +1360,7 @@ If not set, `default-directory' will be used."
(value (pop plist)))
(when value
;; Quote VALUE if it contains suspicious characters.
- (when (string-match "[\"'\\~/*;() \t\n[:multibyte:]]" value)
+ (when (string-match "[][\"'\\~/*;()<>= \t\n[:multibyte:]]" value)
(setq value (with-output-to-string
(let (print-escape-nonascii)
(prin1 value)))))
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 8be1b84e52f..88864ea3579 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -242,7 +242,6 @@ Whether the passphrase is cached at all is controlled by
(defvar epg-user-id-alist)
(autoload 'epg-make-context "epg")
-(autoload 'epg-passphrase-callback-function "epg")
(autoload 'epa-select-keys "epa")
(autoload 'epg-list-keys "epg")
(autoload 'epg-context-set-armor "epg")
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 1e72f681797..45c9bbfe905 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -293,6 +293,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(substring alg (match-end 0))
alg))))
+(autoload 'gnus-get-buffer-create "gnus")
+
(defun mml2015-mailcrypt-verify (handle ctl)
(catch 'error
(let (part)
@@ -330,7 +332,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(replace-match "-----BEGIN PGP SIGNATURE-----" t t))
(if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
(replace-match "-----END PGP SIGNATURE-----" t t)))
- (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
+ (let ((mc-gpg-debug-buffer (gnus-get-buffer-create " *gnus gpg debug*")))
(unless (condition-case err
(prog1
(funcall mml2015-verify-function)
@@ -359,7 +361,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
handle)))
(defun mml2015-mailcrypt-clear-verify ()
- (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
+ (let ((mc-gpg-debug-buffer (gnus-get-buffer-create " *gnus gpg debug*")))
(if (condition-case err
(prog1
(funcall mml2015-verify-function)
@@ -710,7 +712,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(autoload 'epg-verify-string "epg")
(autoload 'epg-sign-string "epg")
(autoload 'epg-encrypt-string "epg")
-(autoload 'epg-passphrase-callback-function "epg")
(autoload 'epg-context-set-passphrase-callback "epg")
(autoload 'epg-key-sub-key-list "epg")
(autoload 'epg-sub-key-capability "epg")
@@ -725,6 +726,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(autoload 'epg-expand-group "epg-config")
(autoload 'epa-select-keys "epa")
+(autoload 'gnus-create-image "gnus-util")
+
(defun mml2015-epg-key-image (key-id)
"Return the image of a key, if any."
(with-temp-buffer
@@ -949,7 +952,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
;;; General wrapper
(autoload 'gnus-buffer-live-p "gnus-util")
-(autoload 'gnus-get-buffer-create "gnus")
(defun mml2015-clean-buffer ()
(if (gnus-buffer-live-p mml2015-result-buffer)
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index 6890f1dceeb..480d794b9ac 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -293,7 +293,7 @@
(deffoo nnbabyl-request-move-article
(article group server accept-form &optional last move-is-internal)
- (let ((buf (get-buffer-create " *nnbabyl move*"))
+ (let ((buf (gnus-get-buffer-create " *nnbabyl move*"))
result)
(and
(nnbabyl-request-article article group server)
@@ -544,7 +544,7 @@
(setq buffer-file-name nnbabyl-mbox-file)
(insert "BABYL OPTIONS:\n\n\^_")
(nnmail-write-region
- (point-min) (point-max) nnbabyl-mbox-file t 'nomesg))))
+ (point-min) (point-max) nnbabyl-mbox-file t 'nomesg nil 'excl))))
(defun nnbabyl-read-mbox ()
(nnmail-activate 'nnbabyl)
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index a7657c68556..ccd17744993 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -597,7 +597,7 @@ all. This may very well take some time.")
(deffoo nndiary-request-move-article
(article group server accept-form &optional last move-is-internal)
- (let ((buf (get-buffer-create " *nndiary move*"))
+ (let ((buf (gnus-get-buffer-create " *nndiary move*"))
result)
(nndiary-possibly-change-directory group server)
(nndiary-update-file-alist)
@@ -831,7 +831,7 @@ all. This may very well take some time.")
;; Find an article number in the current group given the Message-ID.
(defun nndiary-find-group-number (id)
- (with-current-buffer (get-buffer-create " *nndiary id*")
+ (with-current-buffer (gnus-get-buffer-create " *nndiary id*")
(let ((alist nndiary-group-alist)
number)
;; We want to look through all .overview files, but we want to
@@ -992,15 +992,15 @@ all. This may very well take some time.")
(narrow-to-region
(goto-char (point-min))
(if (search-forward "\n\n" nil t) (1- (point)) (point-max))))
- (let ((headers (nnheader-parse-naked-head)))
+ (let ((headers (nnheader-parse-head t)))
(setf (mail-header-chars headers) chars)
(setf (mail-header-number headers) number)
headers))))
(defun nndiary-open-nov (group)
(or (cdr (assoc group nndiary-nov-buffer-alist))
- (let ((buffer (get-buffer-create (format " *nndiary overview %s*"
- group))))
+ (let ((buffer (gnus-get-buffer-create
+ (format " *nndiary overview %s*" group))))
(with-current-buffer buffer
(set (make-local-variable 'nndiary-nov-buffer-file-name)
(expand-file-name
@@ -1086,7 +1086,7 @@ all. This may very well take some time.")
(defun nndiary-generate-nov-file (dir files)
(let* ((dir (file-name-as-directory dir))
(nov (concat dir nndiary-nov-file-name))
- (nov-buffer (get-buffer-create " *nov*"))
+ (nov-buffer (gnus-get-buffer-create " *nov*"))
chars file headers)
;; Init the nov buffer.
(with-current-buffer nov-buffer
@@ -1115,7 +1115,7 @@ all. This may very well take some time.")
(widen))
(setq files (cdr files)))
(with-current-buffer nov-buffer
- (nnmail-write-region 1 (point-max) nov nil 'nomesg)
+ (nnmail-write-region 1 (point-max) nov nil 'nomesg nil 'excl)
(kill-buffer (current-buffer))))))
(defun nndiary-nov-delete-article (group article)
@@ -1425,7 +1425,7 @@ all. This may very well take some time.")
(pop years)))
(if years
;; Because we might not be limited in years, we must guard against
- ;; infinite loops. Appart from cases like Feb 31, there are probably
+ ;; infinite loops. Apart from cases like Feb 31, there are probably
;; other ones, (no monday XXX 2nd etc). I don't know any algorithm to
;; decide this, so I assume that if we reach 10 years later, the
;; schedule is undecidable.
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index 0ba63915c94..81431270d7c 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -347,12 +347,13 @@ from the document.")
(file-exists-p nndoc-address)
(not (file-directory-p nndoc-address))))
(push (cons group (setq nndoc-current-buffer
- (get-buffer-create
+ (gnus-get-buffer-create
(concat " *nndoc " group "*"))))
nndoc-group-alist)
(setq nndoc-dissection-alist nil)
(with-current-buffer nndoc-current-buffer
(erase-buffer)
+ (set-buffer-multibyte nil)
(condition-case error
(if (and (stringp nndoc-address)
(string-match nndoc-binary-file-names nndoc-address))
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el
index a1337e8d7fa..a3c26ea4ac0 100644
--- a/lisp/gnus/nndraft.el
+++ b/lisp/gnus/nndraft.el
@@ -231,7 +231,7 @@ are generated if and only if they are also in `message-draft-headers'."
(deffoo nndraft-request-move-article (article group server accept-form
&optional last move-is-internal)
(nndraft-possibly-change-group group)
- (let ((buf (get-buffer-create " *nndraft move*"))
+ (let ((buf (gnus-get-buffer-create " *nndraft move*"))
result)
(and
(nndraft-request-article article group server)
@@ -325,7 +325,7 @@ are generated if and only if they are also in `message-draft-headers'."
(save-excursion
(prog1
(progn
- (set-buffer (get-buffer-create " *draft tmp*"))
+ (set-buffer (gnus-get-buffer-create " *draft tmp*"))
(setq buffer-file-name file)
(make-auto-save-file-name))
(kill-buffer (current-buffer)))))
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 9e190515f18..9f1fdbae5ae 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -381,7 +381,7 @@ included.")
(defun nneething-get-head (file)
"Either find the head in FILE or make a head for FILE."
- (with-current-buffer (get-buffer-create nneething-work-buffer)
+ (with-current-buffer (gnus-get-buffer-create nneething-work-buffer)
(setq case-fold-search nil)
(buffer-disable-undo)
(erase-buffer)
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 342ac48ba85..6ff99056d84 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -465,7 +465,7 @@ all. This may very well take some time.")
(deffoo nnfolder-request-move-article (article group server accept-form
&optional last move-is-internal)
(save-excursion
- (let ((buf (get-buffer-create " *nnfolder move*"))
+ (let ((buf (gnus-get-buffer-create " *nnfolder move*"))
result)
(and
(nnfolder-request-article article group server)
@@ -735,7 +735,7 @@ deleted. Point is left where the deleted region was."
(or nnfolder-file-coding-system-for-write
nnfolder-file-coding-system-for-write)))
(nnmail-write-region (point-min) (point-min)
- file t 'nomesg)))
+ file t 'nomesg nil 'excl)))
(when (setq nnfolder-current-buffer (nnfolder-read-folder group))
(set-buffer nnfolder-current-buffer)
(push (list group nnfolder-current-buffer)
@@ -1096,7 +1096,7 @@ This command does not work if you use short group names."
(defun nnfolder-open-nov (group)
(or (cdr (assoc group nnfolder-nov-buffer-alist))
- (let ((buffer (get-buffer-create (format " *nnfolder overview %s*" group))))
+ (let ((buffer (gnus-get-buffer-create (format " *nnfolder overview %s*" group))))
(with-current-buffer buffer
(set (make-local-variable 'nnfolder-nov-buffer-file-name)
(nnfolder-group-nov-pathname group))
@@ -1160,7 +1160,7 @@ This command does not work if you use short group names."
(if (search-forward "\n\n" e t) (setq e (1- (point)))))
(with-temp-buffer
(insert-buffer-substring buf b e)
- (let ((headers (nnheader-parse-naked-head)))
+ (let ((headers (nnheader-parse-head t)))
(setf (mail-header-chars headers) chars)
(setf (mail-header-number headers) number)
headers)))))
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 03b08854b11..2952e20928b 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -28,6 +28,10 @@
(eval-when-compile (require 'cl-lib))
+(defvar gnus-decode-encoded-word-function)
+(defvar gnus-decode-encoded-address-function)
+(defvar gnus-alter-header-function)
+
(defvar nnmail-extra-headers)
(defvar gnus-newsgroup-name)
(defvar jka-compr-compression-info-list)
@@ -39,6 +43,7 @@
(require 'mail-utils)
(require 'mm-util)
(require 'gnus-util)
+(autoload 'gnus-remove-odd-characters "gnus-sum")
(autoload 'gnus-range-add "gnus-range")
(autoload 'gnus-remove-from-range "gnus-range")
;; FIXME none of these are used explicitly in this file.
@@ -188,124 +193,166 @@ on your system, you could say something like:
(autoload 'ietf-drums-unfold-fws "ietf-drums")
-(defun nnheader-parse-naked-head (&optional number)
- ;; This function unfolds continuation lines in this buffer
- ;; destructively. When this side effect is unwanted, use
- ;; `nnheader-parse-head' instead of this function.
- (let ((case-fold-search t)
- (buffer-read-only nil)
+
+(defsubst nnheader-head-make-header (number)
+ "Return a full mail header with article NUMBER.
+Do this using data of type `head' in the current buffer."
+ (let ((p (point-min))
(cur (current-buffer))
- (p (point-min))
- in-reply-to lines ref)
- (nnheader-remove-cr-followed-by-lf)
- (ietf-drums-unfold-fws)
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (goto-char p)
- (insert "\n")
- (prog1
- ;; This implementation of this function, with nine
- ;; search-forwards instead of the one re-search-forward and a
- ;; case (which basically was the old function) is actually
- ;; about twice as fast, even though it looks messier. You
- ;; can't have everything, I guess. Speed and elegance don't
- ;; always go hand in hand.
- (vector
- ;; Number.
- (or number 0)
- ;; Subject.
- (progn
- (goto-char p)
- (if (search-forward "\nsubject:" nil t)
- (nnheader-header-value) "(none)"))
- ;; From.
- (progn
- (goto-char p)
- (if (search-forward "\nfrom:" nil t)
- (nnheader-header-value) "(nobody)"))
- ;; Date.
- (progn
- (goto-char p)
- (if (search-forward "\ndate:" nil t)
- (nnheader-header-value) ""))
- ;; Message-ID.
- (progn
- (goto-char p)
- (if (search-forward "\nmessage-id:" nil t)
- (buffer-substring
- (1- (or (search-forward "<" (point-at-eol) t)
- (point)))
- (or (search-forward ">" (point-at-eol) t) (point)))
- ;; If there was no message-id, we just fake one to make
- ;; subsequent routines simpler.
- (nnheader-generate-fake-message-id number)))
- ;; References.
- (progn
+ in-reply-to chars lines end ref)
+ ;; This implementation of this function, with nine
+ ;; search-forwards instead of the one re-search-forward and a
+ ;; case (which basically was the old function) is actually
+ ;; about twice as fast, even though it looks messier. You
+ ;; can't have everything, I guess. Speed and elegance don't
+ ;; always go hand in hand.
+ (make-full-mail-header
+ ;; Number.
+ number
+ ;; Subject.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nsubject:" nil t)
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-header-value))
+ "(none)"))
+ ;; From.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nfrom:" nil t)
+ (funcall gnus-decode-encoded-address-function
+ (nnheader-header-value))
+ "(nobody)"))
+ ;; Date.
+ (progn
+ (goto-char p)
+ (if (search-forward "\ndate:" nil t)
+ (nnheader-header-value) ""))
+ ;; Message-ID.
+ (progn
+ (goto-char p)
+ (if (re-search-forward
+ "^message-id: *\\(<[^\n\t> ]+>\\)" nil t)
+ ;; We do it this way to make sure the Message-ID
+ ;; is (somewhat) syntactically valid.
+ (buffer-substring (match-beginning 1)
+ (match-end 1))
+ ;; If there was no message-id, we just fake one to make
+ ;; subsequent routines simpler.
+ (nnheader-generate-fake-message-id number)))
+ ;; References.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nreferences:" nil t)
+ (progn
+ (setq end (point))
+ (prog1
+ (nnheader-header-value)
+ (setq ref
+ (buffer-substring
+ (progn
+ (end-of-line)
+ (search-backward ">" end t)
+ (1+ (point)))
+ (progn
+ (search-backward "<" end t)
+ (point))))))
+ ;; Get the references from the in-reply-to header if there
+ ;; were no references and the in-reply-to header looks
+ ;; promising.
+ (if (and (search-forward "\nin-reply-to:" nil t)
+ (setq in-reply-to (nnheader-header-value))
+ (string-match "<[^>]+>" in-reply-to))
+ (let (ref2)
+ (setq ref (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (while (string-match "<[^>]+>" in-reply-to (match-end 0))
+ (setq ref2 (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (when (> (length ref2) (length ref))
+ (setq ref ref2)))
+ ref)
+ nil)))
+ ;; Chars.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nchars: " nil t)
+ (if (numberp (setq chars (ignore-errors (read cur))))
+ chars -1)
+ -1))
+ ;; Lines.
+ (progn
+ (goto-char p)
+ (if (search-forward "\nlines: " nil t)
+ (if (numberp (setq lines (ignore-errors (read cur))))
+ lines -1)
+ -1))
+ ;; Xref.
+ (progn
+ (goto-char p)
+ (and (search-forward "\nxref:" nil t)
+ (nnheader-header-value)))
+ ;; Extra.
+ (when nnmail-extra-headers
+ (let ((extra nnmail-extra-headers)
+ out)
+ (while extra
(goto-char p)
- (if (search-forward "\nreferences:" nil t)
- (nnheader-header-value)
- ;; Get the references from the in-reply-to header if
- ;; there were no references and the in-reply-to header
- ;; looks promising.
- (if (and (search-forward "\nin-reply-to:" nil t)
- (setq in-reply-to (nnheader-header-value))
- (string-match "<[^\n>]+>" in-reply-to))
- (let (ref2)
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (while (string-match "<[^\n>]+>"
- in-reply-to (match-end 0))
- (setq ref2 (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (when (> (length ref2) (length ref))
- (setq ref ref2)))
- ref)
- nil)))
- ;; Chars.
- 0
- ;; Lines.
- (progn
- (goto-char p)
- (if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (read cur)))
- lines 0)
- 0))
- ;; Xref.
- (progn
- (goto-char p)
- (and (search-forward "\nxref:" nil t)
- (nnheader-header-value)))
- ;; Extra.
- (when nnmail-extra-headers
- (let ((extra nnmail-extra-headers)
- out)
- (while extra
- (goto-char p)
- (when (search-forward
- (concat "\n" (symbol-name (car extra)) ":") nil t)
- (push (cons (car extra) (nnheader-header-value))
- out))
- (pop extra))
- out)))
- (goto-char p)
- (delete-char 1))))
-
-(defun nnheader-parse-head (&optional naked)
- (let ((cur (current-buffer)) num beg end)
- (when (if naked
- (setq num 0
- beg (point-min)
- end (point-max))
- ;; Search to the beginning of the next header. Error
- ;; messages do not begin with 2 or 3.
- (when (re-search-forward "^[23][0-9]+ " nil t)
- (setq num (read cur)
- beg (point)
- end (if (search-forward "\n.\n" nil t)
- (goto-char (- (point) 2))
- (point)))))
- (with-temp-buffer
- (insert-buffer-substring cur beg end)
- (nnheader-parse-naked-head num)))))
+ (when (search-forward
+ (concat "\n" (symbol-name (car extra)) ":") nil t)
+ (push (cons (car extra) (nnheader-header-value))
+ out))
+ (pop extra))
+ out)))))
+
+(defun nnheader-parse-head (&optional naked temp)
+ "Parse data of type `header' in the current buffer and return a mail header.
+Modify the buffer contents in the process. The buffer is assumed
+to begin each header with an \"Article retrieved\" line with an
+article number; if NAKED is non-nil this line is assumed absent,
+and the buffer should contain a single header's worth of data.
+If TEMP is non-nil the data is first copied to a temporary buffer
+leaving the original buffer untouched."
+ (let ((cur (current-buffer))
+ (num 0)
+ (beg (point-min))
+ (end (point-max))
+ buf)
+ (when (or naked
+ ;; Search to the beginning of the next header. Error
+ ;; messages do not begin with 2 or 3.
+ (when (re-search-forward "^[23][0-9]+ " nil t)
+ (setq num (read cur)
+ beg (point)
+ end (if (search-forward "\n.\n" nil t)
+ (goto-char (- (point) 2))
+ (point)))))
+ ;; When TEMP copy the data to a temporary buffer.
+ (if temp
+ (progn
+ (set-buffer (setq buf (generate-new-buffer " *nnheader-temp*")))
+ (insert-buffer-substring cur beg end))
+ ;; Otherwise just narrow to the data.
+ (narrow-to-region beg end))
+ (let ((case-fold-search t)
+ (buffer-read-only nil)
+ header)
+ (nnheader-remove-cr-followed-by-lf)
+ (ietf-drums-unfold-fws)
+ (subst-char-in-region (point-min) (point-max) ?\t ?\s t)
+ (subst-char-in-region (point-min) (point-max) ?\r ?\s t)
+ (goto-char (point-min))
+ (insert "\n")
+ (setq header (nnheader-head-make-header num))
+ (goto-char (point-min))
+ (delete-char 1)
+ (if temp
+ (kill-buffer buf)
+ (goto-char (point-max))
+ (widen))
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function header))
+ header))))
(defmacro nnheader-nov-skip-field ()
'(search-forward "\t" eol 'move))
@@ -347,24 +394,43 @@ on your system, you could say something like:
'id)
(nnheader-generate-fake-message-id ,number))))
-(defun nnheader-parse-nov ()
+(defalias 'nnheader-nov-make-header 'nnheader-parse-nov)
+(autoload 'gnus-extract-message-id-from-in-reply-to "gnus-sum")
+
+(defun nnheader-parse-nov (&optional number)
(let ((eol (point-at-eol))
- (number (nnheader-nov-read-integer)))
- (vector
- number ; number
- (nnheader-nov-field) ; subject
- (nnheader-nov-field) ; from
- (nnheader-nov-field) ; date
- (nnheader-nov-read-message-id number) ; id
- (nnheader-nov-field) ; refs
- (nnheader-nov-read-integer) ; chars
- (nnheader-nov-read-integer) ; lines
- (if (eq (char-after) ?\n)
- nil
- (if (looking-at "Xref: ")
- (goto-char (match-end 0)))
- (nnheader-nov-field)) ; Xref
- (nnheader-nov-parse-extra)))) ; extra
+ references in-reply-to x header)
+ (setq header
+ (make-full-mail-header
+ (or number (nnheader-nov-read-integer)) ; number
+ (condition-case () ; subject
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-word-function
+ (setq x (nnheader-nov-field))))
+ (error x))
+ (condition-case () ; from
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-address-function
+ (setq x (nnheader-nov-field))))
+ (error x))
+ (nnheader-nov-field) ; date
+ (nnheader-nov-read-message-id number) ; id
+ (setq references (nnheader-nov-field)) ; refs
+ (nnheader-nov-read-integer) ; chars
+ (nnheader-nov-read-integer) ; lines
+ (unless (eobp)
+ (if (looking-at "Xref: ")
+ (goto-char (match-end 0)))
+ (nnheader-nov-field)) ; Xref
+ (nnheader-nov-parse-extra))) ; extra
+
+ (when (and (string= references "")
+ (setq in-reply-to (mail-header-extra header))
+ (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
+ (setf (mail-header-references header)
+ (gnus-extract-message-id-from-in-reply-to in-reply-to)))
+ header))
+
(defun nnheader-insert-nov (header)
(princ (mail-header-number header) (current-buffer))
@@ -399,17 +465,6 @@ on your system, you could say something like:
(delete-char 1))
(forward-line 1)))
-(defun nnheader-parse-overview-file (file)
- "Parse FILE and return a list of headers."
- (mm-with-unibyte-buffer
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (let (headers)
- (while (not (eobp))
- (push (nnheader-parse-nov) headers)
- (forward-line 1))
- (nreverse headers))))
-
(defun nnheader-write-overview-file (file headers)
"Write HEADERS to FILE."
(with-temp-file file
@@ -487,8 +542,8 @@ the line could be found."
(< num article)))
(forward-line 1)
(setq found (point))
- (or (eobp)
- (= (setq num (read cur)) article)))
+ (unless (eobp)
+ (setq num (read cur))))
(unless (eq num article)
(goto-char found)))
(beginning-of-line)
@@ -502,10 +557,12 @@ the line could be found."
"Coding system used in file backends of Gnus.")
(defvar nnheader-callback-function nil)
+(autoload 'gnus-get-buffer-create "gnus")
+
(defun nnheader-init-server-buffer ()
"Initialize the Gnus-backend communication buffer."
(unless (gnus-buffer-live-p nntp-server-buffer)
- (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
+ (setq nntp-server-buffer (gnus-get-buffer-create " *nntpd*")))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(mm-enable-multibyte)
@@ -630,7 +687,7 @@ the line could be found."
(defun nnheader-set-temp-buffer (name &optional noerase)
"Set-buffer to an empty (possibly new) buffer called NAME with undo disabled."
- (set-buffer (get-buffer-create name))
+ (set-buffer (gnus-get-buffer-create name))
(buffer-disable-undo)
(unless noerase
(erase-buffer))
@@ -1010,6 +1067,8 @@ See `find-file-noselect' for the arguments."
(setq nnheader-last-message-time now)
(apply 'nnheader-message args))))
+(make-obsolete-variable 'nnheader-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'nnheader-load-hook)
(provide 'nnheader)
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index c383e0146f3..7984998d214 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -365,7 +365,7 @@ textual parts.")
(mm-disable-multibyte)
(buffer-disable-undo)
(gnus-add-buffer)
- (set (make-local-variable 'after-change-functions) nil)
+ (set (make-local-variable 'after-change-functions) nil) ;FIXME: Why?
(set (make-local-variable 'nnimap-object)
(make-nnimap :server (nnoo-current-server 'nnimap)
:initial-resync 0))
@@ -986,7 +986,10 @@ textual parts.")
(when (and (car result) (not can-move))
(nnimap-delete-article article))
(cons internal-move-group
- (or (nnimap-find-uid-response "COPYUID" (caddr result))
+ (or (nnimap-find-uid-response
+ "COPYUID"
+ ;; Server gives different responses for MOVE and COPY.
+ (if can-move (caddr result) (cadr result)))
(nnimap-find-article-by-message-id
internal-move-group server message-id
nnimap-request-articles-find-limit)))))
@@ -1670,8 +1673,7 @@ If LIMIT, first try to limit the search to the N last articles."
(when (and active
recent
(> (car (last recent)) (cdr active)))
- (push (list (cons (gnus-group-real-name group) 0))
- nnmail-split-history)))
+ (push (list (cons group 0)) nnmail-split-history)))
;; Note the active level for the next run-through.
(gnus-group-set-parameter info 'active (gnus-active group))
(gnus-group-set-parameter info 'uidvalidity uidvalidity)
@@ -1684,7 +1686,7 @@ If LIMIT, first try to limit the search to the N last articles."
(gnus-add-to-range
(gnus-add-to-range
(gnus-range-add (gnus-info-read info)
- vanished)
+ vanished)
(cdr (assq '%Flagged flags)))
(cdr (assq '%Seen flags))))
(let ((marks (gnus-info-marks info)))
@@ -1770,11 +1772,6 @@ If LIMIT, first try to limit the search to the N last articles."
;; read it.
(subst-char-in-region (point-min) (point-max)
?\\ ?% t)
- ;; Remove any MODSEQ entries in the buffer, because they may contain
- ;; numbers that are too large for 32-bit Emacsen.
- (while (re-search-forward " MODSEQ ([0-9]+)" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
(let (start end articles groups uidnext elems permanent-flags
uidvalidity vanished highestmodseq)
(dolist (elem sequences)
@@ -1801,8 +1798,9 @@ If LIMIT, first try to limit the search to the N last articles."
(setq uidvalidity
(and (re-search-forward "UIDVALIDITY \\([0-9]+\\)"
end t)
- ;; Store UIDVALIDITY as a string, as it's
- ;; too big for 32-bit Emacsen, usually.
+ ;; Store UIDVALIDITY as a string; before bignums,
+ ;; it was usually too big for 32-bit Emacsen,
+ ;; and we don't want to change the format now.
(match-string 1)))
(goto-char start)
(setq vanished
@@ -1849,15 +1847,15 @@ If LIMIT, first try to limit the search to the N last articles."
(setq nnimap-status-string "Read-only server")
nil)
-(defvar gnus-refer-thread-use-nnir) ;; gnus-sum.el
+(defvar gnus-refer-thread-use-search) ;; gnus-sum.el
(declare-function gnus-fetch-headers "gnus-sum"
(articles &optional limit force-new dependencies))
-(autoload 'nnir-search-thread "nnir")
+(autoload 'nnselect-search-thread "nnselect")
(deffoo nnimap-request-thread (header &optional group server)
- (if gnus-refer-thread-use-nnir
- (nnir-search-thread header)
+ (if gnus-refer-thread-use-search
+ (nnselect-search-thread header)
(when (nnimap-change-group group server)
(let* ((cmd (nnimap-make-thread-query header))
(result (with-current-buffer (nnimap-buffer)
@@ -1937,7 +1935,7 @@ Return the server's response to the SELECT or EXAMINE command."
(defun nnimap-log-buffer ()
(let ((name "*imap log*"))
(or (get-buffer name)
- (with-current-buffer (get-buffer-create name)
+ (with-current-buffer (gnus-get-buffer-create name)
(setq-local window-point-insertion-type t)
(current-buffer)))))
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index d64d0ed0006..57801d6f9e6 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1047,7 +1047,7 @@ will be copied over from that buffer."
(list (list group ""))
nnmail-split-methods)))
;; Insert the incoming file.
- (with-current-buffer (get-buffer-create nnmail-article-buffer)
+ (with-current-buffer (gnus-get-buffer-create nnmail-article-buffer)
(erase-buffer)
(if (bufferp incoming)
(insert-buffer-substring incoming)
@@ -1574,7 +1574,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
() ; The buffer is open.
(with-current-buffer
(setq nnmail-cache-buffer
- (get-buffer-create " *nnmail message-id cache*"))
+ (gnus-get-buffer-create " *nnmail message-id cache*"))
(gnus-add-buffer)
(when (file-exists-p nnmail-message-id-cache-file)
(nnheader-insert-file-contents nnmail-message-id-cache-file))
@@ -1749,7 +1749,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(nreverse (nnmail-article-group artnum-func))))))
;; Add the group-art list to the history list.
(if group-art
- (push group-art nnmail-split-history)
+ ;; We need to get the unique Gnus group name for this article
+ ;; -- there may be identically named groups from several
+ ;; backends.
+ (push (mapcar
+ (lambda (ga)
+ (cons (gnus-group-prefixed-name (car ga) gnus-command-method)
+ (cdr ga)))
+ group-art)
+ nnmail-split-history)
(delete-region (point-min) (point-max)))))
;;; Get new mail.
@@ -1953,12 +1961,14 @@ If TIME is nil, then return the cutoff time for oldness instead."
(unless (re-search-forward "^Message-ID[ \t]*:" nil t)
(insert "Message-ID: " (nnmail-message-id) "\n")))))
-(defun nnmail-write-region (start end filename &optional append visit lockname)
+(defun nnmail-write-region (start end filename
+ &optional append visit lockname mustbenew)
"Do a `write-region', and then set the file modes."
(let ((coding-system-for-write nnmail-file-coding-system)
(file-name-coding-system nnmail-pathname-coding-system))
- (write-region start end filename append visit lockname)
- (set-file-modes filename nnmail-default-file-modes)))
+ (write-region start end filename append visit lockname mustbenew)
+ (set-file-modes filename nnmail-default-file-modes
+ (when (eq mustbenew 'excl) 'nofollow))))
;;;
;;; Status functions
@@ -2065,13 +2075,15 @@ Doesn't change point."
(when nnmail-split-tracing
(push split nnmail-split-trace))
(when nnmail-debug-splitting
- (with-current-buffer (get-buffer-create "*nnmail split*")
+ (with-current-buffer (gnus-get-buffer-create "*nnmail split*")
(goto-char (point-max))
(insert (format-time-string "%FT%T")
" "
(format "%S" split)
"\n"))))
+(make-obsolete-variable 'nnmail-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'nnmail-load-hook)
(provide 'nnmail)
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 9cf766ee465..68c31dc4510 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1,4 +1,4 @@
-;;; nnmaildir.el --- maildir backend for Gnus
+;;; nnmaildir.el --- maildir backend for Gnus -*- lexical-binding:t -*-
;; This file is in the public domain.
@@ -261,7 +261,7 @@ This variable is set by `nnmaildir-request-article'.")
(defun nnmaildir--param (pgname param)
(setq param (gnus-group-find-parameter pgname param 'allow-list))
(if (vectorp param) (setq param (aref param 0)))
- (eval param))
+ (eval param t))
(defmacro nnmaildir--with-nntp-buffer (&rest body)
(declare (debug (body)))
@@ -269,15 +269,15 @@ This variable is set by `nnmaildir-request-article'.")
,@body))
(defmacro nnmaildir--with-work-buffer (&rest body)
(declare (debug (body)))
- `(with-current-buffer (get-buffer-create " *nnmaildir work*")
+ `(with-current-buffer (gnus-get-buffer-create " *nnmaildir work*")
,@body))
(defmacro nnmaildir--with-nov-buffer (&rest body)
(declare (debug (body)))
- `(with-current-buffer (get-buffer-create " *nnmaildir nov*")
+ `(with-current-buffer (gnus-get-buffer-create " *nnmaildir nov*")
,@body))
(defmacro nnmaildir--with-move-buffer (&rest body)
(declare (debug (body)))
- `(with-current-buffer (get-buffer-create " *nnmaildir move*")
+ `(with-current-buffer (gnus-get-buffer-create " *nnmaildir move*")
,@body))
(defsubst nnmaildir--subdir (dir subdir)
@@ -492,7 +492,7 @@ This variable is set by `nnmaildir-request-article'.")
(setq nov-mid 0))
(goto-char (point-min))
(delete-char 1)
- (setq nov (nnheader-parse-naked-head)
+ (setq nov (nnheader-parse-head t)
field (or (mail-header-lines nov) 0)))
(unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:))
(setq nov-mid field))
@@ -690,7 +690,7 @@ This variable is set by `nnmaildir-request-article'.")
"You must set \"directory\" in the select method")
(throw 'return nil))
(setq dir (cadr dir)
- dir (eval dir)
+ dir (eval dir t) ;FIXME: Why `eval'?
dir (expand-file-name dir)
dir (file-name-as-directory dir))
(unless (file-exists-p dir)
@@ -717,13 +717,13 @@ This variable is set by `nnmaildir-request-article'.")
(if x
(progn
(setq x (cadr x)
- x (eval x))
+ x (eval x t)) ;FIXME: Why `eval'?
(setf (nnmaildir--srv-target-prefix server) x))
(setq x (assq 'create-directory defs))
(if x
(progn
(setq x (cadr x)
- x (eval x)
+ x (eval x t) ;FIXME: Why `eval'?
x (file-name-as-directory x))
(setf (nnmaildir--srv-target-prefix server) x))
(setf (nnmaildir--srv-target-prefix server) "")))
@@ -1428,7 +1428,7 @@ This variable is set by `nnmaildir-request-article'.")
(nnmaildir--with-move-buffer
(erase-buffer)
(nnheader-insert-file-contents nnmaildir--file)
- (setq result (eval accept-form)))
+ (setq result (eval accept-form t)))
(unless (or (null result) (nnmaildir--param pgname 'read-only))
(nnmaildir--unlink nnmaildir--file)
(nnmaildir--expired-article group article))
@@ -1544,7 +1544,7 @@ This variable is set by `nnmaildir-request-article'.")
(defun nnmaildir-request-expire-articles (ranges &optional gname server force)
(let ((no-force (not force))
(group (nnmaildir--prepare server gname))
- pgname time boundary high low target dir nlist
+ pgname time boundary target dir nlist
didnt nnmaildir--file nnmaildir-article-file-name
deactivate-mark)
(catch 'return
@@ -1720,18 +1720,23 @@ This variable is set by `nnmaildir-request-article'.")
(defun nnmaildir-close-group (gname &optional server)
(let ((group (nnmaildir--prepare server gname))
- pgname ls dir msgdir files flist dirs)
+ pgname ls dir msgdir files dirs
+ (fset (make-hash-table :test #'equal)))
(if (null group)
(progn
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
nil)
+ ;; Delete the now obsolete NOV files.
+ ;; FIXME: This can take a somewhat long time, so maybe it's better
+ ;; to do it asynchronously (i.e. in an idle timer).
(setq pgname (nnmaildir--pgname nnmaildir--cur-server gname)
ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
msgdir (if (nnmaildir--param pgname 'read-only)
(nnmaildir--new dir) (nnmaildir--cur dir))
+ ;; The dir with the NOV files.
dir (nnmaildir--nndir dir)
dirs (cons (nnmaildir--nov-dir dir)
(funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
@@ -1744,14 +1749,15 @@ This variable is set by `nnmaildir-request-article'.")
(save-match-data
(dolist (file files)
(string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
- (push (match-string 1 file) flist)))
+ (puthash (match-string 1 file) t fset)))
+ ;; Not sure why, but we specifically avoid deleting the `:' file.
+ (puthash ":" t fset)
(dolist (dir dirs)
(setq files (cdr dir)
dir (file-name-as-directory (car dir)))
(dolist (file files)
- (unless (or (member file flist) (string= file ":"))
- (setq file (concat dir file))
- (delete-file file))))
+ (unless (gethash file fset)
+ (delete-file (concat dir file)))))
t)))
(defun nnmaildir-close-server (&optional server _defs)
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index b3329212f84..dcecfcf6519 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1249,7 +1249,7 @@ Marks propagation has to be enabled for this to work."
If THREADS is non-nil, enable full threads."
(let ((args (cons (car command) '(nil t nil))))
(with-current-buffer
- (get-buffer-create nnmairix-mairix-output-buffer)
+ (gnus-get-buffer-create nnmairix-mairix-output-buffer)
(erase-buffer)
(when (> (length command) 1)
(setq args (append args (cdr command))))
@@ -1267,7 +1267,7 @@ If THREADS is non-nil, enable full threads."
"Call mairix binary with COMMAND and QUERY in raw mode."
(let ((args (cons (car command) '(nil t nil))))
(with-current-buffer
- (get-buffer-create nnmairix-mairix-output-buffer)
+ (gnus-get-buffer-create nnmairix-mairix-output-buffer)
(erase-buffer)
(when (> (length command) 1)
(setq args (append args (cdr command))))
@@ -1404,7 +1404,7 @@ TYPE is either `nov' or `headers'."
(nnheader-message 7 "nnmairix: Rewriting headers...")
(cond
((eq type 'nov)
- (let ((buf (get-buffer-create " *nnmairix buffer*"))
+ (let ((buf (gnus-get-buffer-create " *nnmairix buffer*"))
(corr (not (zerop numc)))
(name (buffer-name nntp-server-buffer))
header cur xref)
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index eb8fcf37a25..8b3d80266e7 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -280,7 +280,7 @@
(deffoo nnmbox-request-move-article
(article group server accept-form &optional last move-is-internal)
- (let ((buf (get-buffer-create " *nnmbox move*"))
+ (let ((buf (gnus-get-buffer-create " *nnmbox move*"))
result)
(and
(nnmbox-request-article article group server)
@@ -613,7 +613,7 @@
(dir (file-name-directory nnmbox-mbox-file)))
(and dir (gnus-make-directory dir))
(nnmail-write-region (point-min) (point-min)
- nnmbox-mbox-file t 'nomesg))))
+ nnmbox-mbox-file t 'nomesg nil 'excl))))
(defun nnmbox-read-mbox ()
(nnmail-activate 'nnmbox)
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 8e7f0565e67..581a408009d 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -296,7 +296,7 @@ as unread by Gnus.")
(deffoo nnmh-request-move-article (article group server accept-form
&optional last move-is-internal)
- (let ((buf (get-buffer-create " *nnmh move*"))
+ (let ((buf (gnus-get-buffer-create " *nnmh move*"))
result)
(and
(nnmh-deletable-article-p group article)
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 6c7b25b5e76..ad608b6575e 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -361,7 +361,7 @@ non-nil.")
(deffoo nnml-request-move-article
(article group server accept-form &optional last move-is-internal)
- (let ((buf (get-buffer-create " *nnml move*"))
+ (let ((buf (gnus-get-buffer-create " *nnml move*"))
(file-name-coding-system nnmail-pathname-coding-system)
result)
(nnml-possibly-change-directory group server)
@@ -572,7 +572,7 @@ non-nil.")
;; Find an article number in the current group given the Message-ID.
(defun nnml-find-group-number (id server)
- (with-current-buffer (get-buffer-create " *nnml id*")
+ (with-current-buffer (gnus-get-buffer-create " *nnml id*")
(let ((alist nnml-group-alist)
number)
;; We want to look through all .overview files, but we want to
@@ -766,17 +766,16 @@ article number. This function is called narrowed to an article."
(if (re-search-forward "\n\r?\n" nil t)
(1- (point))
(point-max))))
- (let ((headers (nnheader-parse-naked-head)))
+ (let ((headers (nnheader-parse-head t)))
(setf (mail-header-chars headers) chars)
(setf (mail-header-number headers) number)
headers))))
(defun nnml-get-nov-buffer (group &optional incrementalp)
- (let ((buffer (get-buffer-create (format " *nnml %soverview %s*"
- (if incrementalp
- "incremental "
- "")
- group)))
+ (let ((buffer (gnus-get-buffer-create
+ (format " *nnml %soverview %s*"
+ (if incrementalp "incremental " "")
+ group)))
(file-name-coding-system nnmail-pathname-coding-system))
(with-current-buffer buffer
(set (make-local-variable 'nnml-nov-buffer-file-name)
@@ -873,7 +872,7 @@ Unless no-active is non-nil, update the active file too."
(defun nnml-generate-nov-file (dir files)
(let* ((dir (file-name-as-directory dir))
(nov (concat dir nnml-nov-file-name))
- (nov-buffer (get-buffer-create " *nov*"))
+ (nov-buffer (gnus-get-buffer-create " *nov*"))
chars file headers)
(with-current-buffer nov-buffer
;; Init the nov buffer.
@@ -902,7 +901,7 @@ Unless no-active is non-nil, update the active file too."
(nnheader-insert-nov headers)))
(widen))))
(with-current-buffer nov-buffer
- (nnmail-write-region (point-min) (point-max) nov nil 'nomesg)
+ (nnmail-write-region (point-min) (point-max) nov nil 'nomesg nil 'excl)
(kill-buffer (current-buffer))))))
(defun nnml-nov-delete-article (group article)
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index fa4d22fb1cc..48c07da1cc8 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -450,7 +450,7 @@ nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s"
(defun nnrss-normalize-date (date)
"Return a date string of DATE in the style of RFC 822 and its successors.
This function handles the ISO 8601 date format described in
-URL `http://www.w3.org/TR/NOTE-datetime', and also the RFC 822 style
+URL `https://www.w3.org/TR/NOTE-datetime', and also the RFC 822 style
which RSS 2.0 allows."
(let (case-fold-search vector year month day time zone cts given)
(cond ((null date)) ; do nothing for this case
@@ -739,7 +739,7 @@ Read the file and attempt to subscribe to each Feed in the file."
"OPML subscription export.
Export subscriptions to a buffer in OPML Format."
(interactive)
- (with-current-buffer (get-buffer-create "*OPML Export*")
+ (with-current-buffer (gnus-get-buffer-create "*OPML Export*")
(set-buffer-file-coding-system 'utf-8)
(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
"<!-- OPML generated by Emacs Gnus' nnrss.el -->\n"
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
new file mode 100644
index 00000000000..e4753fe95c8
--- /dev/null
+++ b/lisp/gnus/nnselect.el
@@ -0,0 +1,970 @@
+;;; nnselect.el --- a virtual group backend -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Andrew Cohen <cohen@andy.bu.edu>
+;; Keywords: news mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a "virtual" backend that allows an arbitrary list of
+;; articles to be treated as a Gnus group. An nnselect group uses an
+;; `nnselect-spec' group parameter to specify this list of
+;; articles. `nnselect-spec' is an alist with two keys:
+;; `nnselect-function', whose value should be a function that returns
+;; the list of articles, and `nnselect-args'. The function will be
+;; applied to the arguments to generate the list of articles. The
+;; return value should be a vector, each element of which should in
+;; turn be a vector of three elements: a real prefixed group name, an
+;; article number in that group, and an integer score. The score is
+;; not used by nnselect but may be used by other code to help in
+;; sorting. Most functions will just chose a fixed number, such as
+;; 100, for this score.
+
+;; For example the search function `gnus-search-run-query' applied to
+;; arguments specifying a search query (see "gnus-search.el") can be
+;; used to return a list of articles from a search. Or the function
+;; can be the identity and the args a vector of articles.
+
+
+;;; Code:
+
+;;; Setup:
+
+(require 'gnus-art)
+(require 'gnus-search)
+
+(eval-when-compile (require 'cl-lib))
+
+;; Set up the backend
+
+(nnoo-declare nnselect)
+
+(nnoo-define-basics nnselect)
+
+(gnus-declare-backend "nnselect" 'post-mail 'virtual)
+
+;;; Internal Variables:
+
+(defvar gnus-inhibit-demon)
+(defvar gnus-message-group-art)
+
+;; For future use
+(defvoo nnselect-directory gnus-directory
+ "Directory for the nnselect backend.")
+
+(defvoo nnselect-active-file
+ (expand-file-name "nnselect-active" nnselect-directory)
+ "nnselect active file.")
+
+(defvoo nnselect-groups-file
+ (expand-file-name "nnselect-newsgroups" nnselect-directory)
+ "nnselect groups description file.")
+
+;;; Helper routines.
+(defun nnselect-compress-artlist (artlist)
+ "Compress ARTLIST."
+ (let (selection)
+ (pcase-dolist (`(,artgroup . ,arts)
+ (nnselect-categorize artlist 'nnselect-artitem-group))
+ (let (list)
+ (pcase-dolist (`(,rsv . ,articles)
+ (nnselect-categorize
+ arts 'nnselect-artitem-rsv 'nnselect-artitem-number))
+ (push (cons rsv (gnus-compress-sequence (sort articles '<)))
+ list))
+ (push (cons artgroup list) selection)))
+ selection))
+
+(defun nnselect-uncompress-artlist (artlist)
+ "Uncompress ARTLIST."
+ (if (vectorp artlist)
+ artlist
+ (let (selection)
+ (pcase-dolist (`(,artgroup (,artrsv . ,artseq)) artlist)
+ (setq selection
+ (vconcat
+ (cl-map 'vector
+ #'(lambda (art)
+ (vector artgroup art artrsv))
+ (gnus-uncompress-sequence artseq)) selection)))
+ selection)))
+
+(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1")
+
+;; Data type article list.
+
+(define-inline nnselect-artlist-length (artlist)
+ (inline-quote (length ,artlist)))
+
+(define-inline nnselect-artlist-article (artlist n)
+ "Return from ARTLIST the Nth artitem (counting starting at 1)."
+ (inline-quote (when (> ,n 0)
+ (elt ,artlist (1- ,n)))))
+
+(define-inline nnselect-artitem-group (artitem)
+ "Return the group from the ARTITEM."
+ (inline-quote (elt ,artitem 0)))
+
+(define-inline nnselect-artitem-number (artitem)
+ "Return the number from the ARTITEM."
+ (inline-quote (elt ,artitem 1)))
+
+(define-inline nnselect-artitem-rsv (artitem)
+ "Return the Retrieval Status Value (RSV, score) from the ARTITEM."
+ (inline-quote (elt ,artitem 2)))
+
+(define-inline nnselect-article-group (article)
+ "Return the group for ARTICLE."
+ (inline-quote
+ (nnselect-artitem-group (nnselect-artlist-article
+ gnus-newsgroup-selection ,article))))
+
+(define-inline nnselect-article-number (article)
+ "Return the number for ARTICLE."
+ (inline-quote (nnselect-artitem-number
+ (nnselect-artlist-article
+ gnus-newsgroup-selection ,article))))
+
+(define-inline nnselect-article-rsv (article)
+ "Return the rsv for ARTICLE."
+ (inline-quote (nnselect-artitem-rsv
+ (nnselect-artlist-article
+ gnus-newsgroup-selection ,article))))
+
+(define-inline nnselect-article-id (article)
+ "Return the pair `(nnselect id . real id)' of ARTICLE."
+ (inline-quote (cons ,article (nnselect-article-number ,article))))
+
+(define-inline nnselect-categorize (sequence keyfunc &optional valuefunc)
+ "Sorts a sequence into categories.
+Returns a list of the form
+`((key1 (element11 element12)) (key2 (element21 element22))'.
+The category key for a member of the sequence is obtained
+as `(keyfunc member)' and the corresponding element is just
+`member' (or `(valuefunc member)' if `valuefunc' is non-nil)."
+ (inline-letevals (sequence keyfunc valuefunc)
+ (inline-quote (let ((valuefunc (or ,valuefunc 'identity))
+ result)
+ (unless (null ,sequence)
+ (mapc
+ (lambda (member)
+ (let* ((key (funcall ,keyfunc member))
+ (value (funcall valuefunc member))
+ (kr (assoc key result)))
+ (if kr
+ (push value (cdr kr))
+ (push (list key value) result))))
+ (reverse ,sequence))
+ result)))))
+
+
+;; Unclear whether a macro or an inline function is best.
+;; (defmacro nnselect-categorize (sequence keyfunc &optional valuefunc)
+;; "Sorts a sequence into categories and returns a list of the form
+;; `((key1 (element11 element12)) (key2 (element21 element22))'.
+;; The category key for a member of the sequence is obtained
+;; as `(keyfunc member)' and the corresponding element is just
+;; `member' (or `(valuefunc member)' if `valuefunc' is non-nil)."
+;; (let ((key (make-symbol "key"))
+;; (value (make-symbol "value"))
+;; (result (make-symbol "result"))
+;; (valuefunc (or valuefunc 'identity)))
+;; `(unless (null ,sequence)
+;; (let (,result)
+;; (mapc
+;; (lambda (member)
+;; (let* ((,key (,keyfunc member))
+;; (,value (,valuefunc member))
+;; (kr (assoc ,key ,result)))
+;; (if kr
+;; (push ,value (cdr kr))
+;; (push (list ,key ,value) ,result))))
+;; (reverse ,sequence))
+;; ,result))))
+
+(define-inline ids-by-group (articles)
+ (inline-quote
+ (nnselect-categorize ,articles 'nnselect-article-group
+ 'nnselect-article-id)))
+
+(define-inline numbers-by-group (articles &optional type)
+ (inline-quote
+ (cond
+ ((eq ,type 'range)
+ (nnselect-categorize (gnus-uncompress-range ,articles)
+ 'nnselect-article-group 'nnselect-article-number))
+ ((eq ,type 'tuple)
+ (nnselect-categorize ,articles
+ #'(lambda (elem)
+ (nnselect-article-group (car elem)))
+ #'(lambda (elem)
+ (cons (nnselect-article-number
+ (car elem)) (cdr elem)))))
+ (t
+ (nnselect-categorize ,articles
+ 'nnselect-article-group 'nnselect-article-number)))))
+
+(defmacro nnselect-add-prefix (group)
+ "Ensures that the GROUP has an nnselect prefix."
+ `(gnus-group-prefixed-name
+ (gnus-group-short-name ,group) '(nnselect "nnselect")))
+
+(defmacro nnselect-get-artlist (group)
+ "Retrieve the list of articles for GROUP."
+ `(when (gnus-nnselect-group-p ,group)
+ (nnselect-uncompress-artlist
+ (gnus-group-get-parameter ,group 'nnselect-artlist t))))
+
+(defmacro nnselect-add-novitem (novitem)
+ "Add NOVITEM to the list of headers."
+ `(let* ((novitem ,novitem)
+ (artno (and novitem
+ (mail-header-number novitem)))
+ (art (car-safe (rassq artno artids))))
+ (when art
+ (setf (mail-header-number novitem) art)
+ (push novitem headers))))
+
+;;; User Customizable Variables:
+
+(defgroup nnselect nil
+ "Virtual groups in Gnus with arbitrary selection methods."
+ :group 'gnus)
+
+(define-obsolete-variable-alias 'nnir-retrieve-headers-override-function
+ 'nnselect-retrieve-headers-override-function "28.1")
+
+(defcustom nnselect-retrieve-headers-override-function nil
+ "A function that retrieves article headers for ARTICLES from GROUP.
+The retrieved headers should populate the `nntp-server-buffer'.
+Returns either the retrieved header format 'nov or 'headers.
+
+If this variable is nil, or if the provided function returns nil,
+ `gnus-retrieve-headers' will be called instead."
+ :version "28.1"
+ :type '(repeat function))
+
+;; Gnus backend interface functions.
+
+(deffoo nnselect-open-server (server &optional definitions)
+ ;; Just set the server variables appropriately.
+ (let ((backend (or (car (gnus-server-to-method server)) 'nnselect)))
+ (nnoo-change-server backend server definitions)))
+
+;; (deffoo nnselect-server-opened (&optional server)
+;; "Is SERVER the current virtual server?"
+;; (if (string-empty-p server)
+;; t
+;; (let ((backend (car (gnus-server-to-method server))))
+;; (nnoo-current-server-p (or backend 'nnselect) server))))
+
+(deffoo nnselect-server-opened (&optional _server)
+ t)
+
+
+(deffoo nnselect-request-group (group &optional _server _dont-check info)
+ (let* ((group (nnselect-add-prefix group))
+ (nnselect-artlist (nnselect-get-artlist group))
+ length)
+ ;; Check for cached select result or run the selection and cache
+ ;; the result.
+ (unless nnselect-artlist
+ (gnus-group-set-parameter
+ group 'nnselect-artlist
+ (nnselect-compress-artlist (setq nnselect-artlist
+ (nnselect-run
+ (gnus-group-get-parameter group 'nnselect-specs t)))))
+ (nnselect-request-update-info
+ group (or info (gnus-get-info group))))
+ (if (zerop (setq length (nnselect-artlist-length nnselect-artlist)))
+ (progn
+ (nnheader-report 'nnselect "Selection produced empty results.")
+ (when (gnus-ephemeral-group-p group)
+ (gnus-kill-ephemeral-group group)
+ (setq gnus-ephemeral-servers
+ (assq-delete-all 'nnselect gnus-ephemeral-servers)))
+ (nnheader-insert ""))
+ (with-current-buffer nntp-server-buffer
+ (nnheader-insert "211 %d %d %d %s\n"
+ length ; total #
+ 1 ; first #
+ length ; last #
+ group))) ; group name
+ nnselect-artlist))
+
+
+(deffoo nnselect-retrieve-headers (articles group &optional _server fetch-old)
+ (let ((group (nnselect-add-prefix group)))
+ (with-current-buffer (gnus-summary-buffer-name group)
+ (setq gnus-newsgroup-selection (or gnus-newsgroup-selection
+ (nnselect-get-artlist group)))
+ (let ((gnus-inhibit-demon t)
+ (gartids (ids-by-group articles))
+ headers)
+ (with-current-buffer nntp-server-buffer
+ (pcase-dolist (`(,artgroup . ,artids) gartids)
+ (let ((artlist (sort (mapcar 'cdr artids) '<))
+ (gnus-override-method (gnus-find-method-for-group artgroup))
+ (fetch-old
+ (or
+ (car-safe
+ (gnus-group-find-parameter artgroup
+ 'gnus-fetch-old-headers t))
+ fetch-old)))
+ (erase-buffer)
+ (pcase (setq gnus-headers-retrieved-by
+ (or
+ (and
+ nnselect-retrieve-headers-override-function
+ (funcall
+ nnselect-retrieve-headers-override-function
+ artlist artgroup))
+ (gnus-retrieve-headers
+ artlist artgroup fetch-old)))
+ ('nov
+ (goto-char (point-min))
+ (while (not (eobp))
+ (nnselect-add-novitem
+ (nnheader-parse-nov))
+ (forward-line 1)))
+ ('headers
+ (gnus-run-hooks 'gnus-parse-headers-hook)
+ (let ((nnmail-extra-headers gnus-extra-headers))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (nnselect-add-novitem
+ (nnheader-parse-head))
+ (forward-line 1))))
+ ((pred listp)
+ (dolist (novitem gnus-headers-retrieved-by)
+ (nnselect-add-novitem novitem)))
+ (_ (error "Unknown header type %s while requesting articles \
+ of group %s" gnus-headers-retrieved-by artgroup)))))
+ (setq headers
+ (sort
+ headers
+ (lambda (x y)
+ (< (mail-header-number x) (mail-header-number y))))))))))
+
+
+(deffoo nnselect-request-article (article &optional _group server to-buffer)
+ (let* ((gnus-override-method nil)
+ servers group-art artlist)
+ (if (numberp article)
+ (with-current-buffer gnus-summary-buffer
+ (unless (zerop (nnselect-artlist-length
+ gnus-newsgroup-selection))
+ (setq group-art (cons (nnselect-article-group article)
+ (nnselect-article-number article)))))
+ ;; message-id: either coming from a referral or a pseudo-article
+ ;; find the servers for a pseudo-article
+ (if (eq 'nnselect (car (gnus-server-to-method server)))
+ (with-current-buffer gnus-summary-buffer
+ (let ((thread (gnus-id-to-thread article)))
+ (when thread
+ (mapc
+ (lambda (x)
+ (when (and x (> x 0))
+ (cl-pushnew
+ (list
+ (gnus-method-to-server
+ (gnus-find-method-for-group
+ (nnselect-article-group x)))) servers :test 'equal)))
+ (gnus-articles-in-thread thread)))))
+ (setq servers (list (list server))))
+ (setq artlist
+ (gnus-search-run-query
+ (list
+ (cons 'search-query-spec
+ (list (cons 'query `((id . ,article)))
+ (cons 'criteria "") (cons 'shortcut t)))
+ (cons 'search-group-spec servers))))
+ (unless (zerop (nnselect-artlist-length artlist))
+ (setq
+ group-art
+ (cons
+ (nnselect-artitem-group (nnselect-artlist-article artlist 1))
+ (nnselect-artitem-number (nnselect-artlist-article artlist 1))))))
+ (when (numberp (cdr group-art))
+ (message "Requesting article %d from group %s"
+ (cdr group-art) (car group-art))
+ (if to-buffer
+ (with-current-buffer to-buffer
+ (let ((gnus-article-decode-hook nil))
+ (gnus-request-article-this-buffer
+ (cdr group-art) (car group-art))))
+ (gnus-request-article (cdr group-art) (car group-art)))
+ group-art)))
+
+
+(deffoo nnselect-request-move-article
+ (article _group _server accept-form &optional last _internal-move-group)
+ (let* ((artgroup (nnselect-article-group article))
+ (artnumber (nnselect-article-number article))
+ (to-newsgroup (nth 1 accept-form))
+ (to-method (gnus-find-method-for-group to-newsgroup))
+ (from-method (gnus-find-method-for-group artgroup))
+ (move-is-internal (gnus-server-equal from-method to-method)))
+ (unless (gnus-check-backend-function
+ 'request-move-article artgroup)
+ (error "The group %s does not support article moving" artgroup))
+ (gnus-request-move-article
+ artnumber
+ artgroup
+ (nth 1 from-method)
+ accept-form
+ last
+ (and move-is-internal
+ to-newsgroup ; Not respooling
+ (gnus-group-real-name to-newsgroup)))))
+
+(deffoo nnselect-request-replace-article
+ (article _group buffer &optional no-encode)
+ (pcase-let ((`[,artgroup ,artnumber ,artrsv]
+ (with-current-buffer gnus-summary-buffer
+ (nnselect-artlist-article gnus-newsgroup-selection article))))
+ (unless (gnus-check-backend-function
+ 'request-replace-article artgroup)
+ (user-error "The group %s does not support article editing" artgroup))
+ (let ((newart
+ (gnus-request-replace-article artnumber artgroup buffer no-encode)))
+ (with-current-buffer gnus-summary-buffer
+ (cl-nsubstitute `[,artgroup ,newart ,artrsv]
+ `[,artgroup ,artnumber ,artrsv]
+ gnus-newsgroup-selection
+ :test #'equal :count 1)))))
+
+(deffoo nnselect-request-expire-articles
+ (articles _group &optional _server force)
+ (if force
+ (let (not-expired)
+ (pcase-dolist (`(,artgroup . ,artids) (ids-by-group articles))
+ (let ((artlist (sort (mapcar 'cdr artids) '<)))
+ (unless (gnus-check-backend-function 'request-expire-articles
+ artgroup)
+ (error "Group %s does not support article expiration" artgroup))
+ (unless (gnus-check-server (gnus-find-method-for-group artgroup))
+ (error "Couldn't open server for group %s" artgroup))
+ (push (mapcar #'(lambda (art)
+ (car (rassq art artids)))
+ (let ((nnimap-expunge 'immediately))
+ (gnus-request-expire-articles
+ artlist artgroup force)))
+ not-expired)))
+ (sort (delq nil not-expired) '<))
+ articles))
+
+
+(deffoo nnselect-warp-to-article ()
+ (let* ((cur (if (> (gnus-summary-article-number) 0)
+ (gnus-summary-article-number)
+ (error "Can't warp to a pseudo-article")))
+ (artgroup (nnselect-article-group cur))
+ (artnumber (nnselect-article-number cur))
+ (_quit-config (gnus-ephemeral-group-p gnus-newsgroup-name)))
+
+ ;; what should we do here? we could leave all the buffers around
+ ;; and assume that we have to exit from them one by one. or we can
+ ;; try to clean up directly
+
+ ;;first exit from the nnselect summary buffer.
+ ;;(gnus-summary-exit)
+ ;; and if the nnselect summary buffer in turn came from another
+ ;; summary buffer we have to clean that summary up too.
+ ;;(when (not (eq (cdr quit-config) 'group))
+ ;; (gnus-summary-exit))
+ (gnus-summary-read-group-1 artgroup t t nil
+ nil (list artnumber))))
+
+
+;; we pass this through to the real group in case it wants to adjust
+;; the mark. We also use this to mark an article expirable iff it is
+;; expirable in the real group.
+(deffoo nnselect-request-update-mark (_group article mark)
+ (let* ((artgroup (nnselect-article-group article))
+ (artnumber (nnselect-article-number article))
+ (gmark (gnus-request-update-mark artgroup artnumber mark)))
+ (when (and artnumber
+ (memq mark gnus-auto-expirable-marks)
+ (= mark gmark)
+ (gnus-group-auto-expirable-p artgroup))
+ (setq gmark gnus-expirable-mark))
+ gmark))
+
+
+(deffoo nnselect-request-set-mark (_group actions &optional _server)
+ (mapc
+ (lambda (request) (gnus-request-set-mark (car request) (cdr request)))
+ (nnselect-categorize
+ (cl-mapcan
+ (lambda (act)
+ (cl-destructuring-bind (range action marks) act
+ (mapcar
+ (lambda (artgroup)
+ (list (car artgroup)
+ (gnus-compress-sequence (sort (cdr artgroup) '<))
+ action marks))
+ (numbers-by-group range 'range))))
+ actions)
+ 'car 'cdr)))
+
+(deffoo nnselect-request-update-info (group info &optional _server)
+ (let* ((group (nnselect-add-prefix group))
+ (gnus-newsgroup-selection
+ (or gnus-newsgroup-selection (nnselect-get-artlist group)))
+ newmarks)
+ (gnus-info-set-marks info nil)
+ (setf (gnus-info-read info) nil)
+ (pcase-dolist (`(,artgroup . ,nartids)
+ (ids-by-group
+ (number-sequence 1 (nnselect-artlist-length
+ gnus-newsgroup-selection))))
+ (let* ((gnus-newsgroup-active nil)
+ (artids (cl-sort nartids #'< :key 'car))
+ (group-info (gnus-get-info artgroup))
+ (marks (gnus-info-marks group-info))
+ (unread (gnus-uncompress-sequence
+ (gnus-range-difference (gnus-active artgroup)
+ (gnus-info-read group-info)))))
+ (setf (gnus-info-read info)
+ (gnus-add-to-range
+ (gnus-info-read info)
+ (delq nil (mapcar
+ #'(lambda (art)
+ (unless (memq (cdr art) unread) (car art)))
+ artids))))
+ (pcase-dolist (`(,type . ,mark-list) marks)
+ (let ((mark-type (gnus-article-mark-to-type type)) new)
+ (when
+ (setq new
+ (delq nil
+ (cond
+ ((eq mark-type 'tuple)
+ (mapcar
+ #'(lambda (id)
+ (let (mark)
+ (when
+ (setq mark (assq (cdr id) mark-list))
+ (cons (car id) (cdr mark)))))
+ artids))
+ (t
+ (setq mark-list
+ (gnus-uncompress-range mark-list))
+ (mapcar
+ #'(lambda (id)
+ (when (memq (cdr id) mark-list)
+ (car id))) artids)))))
+ (let ((previous (alist-get type newmarks)))
+ (if previous
+ (nconc previous new)
+ (push (cons type new) newmarks))))))))
+
+ ;; Clean up the marks: compress lists;
+ (pcase-dolist (`(,type . ,mark-list) newmarks)
+ (let ((mark-type (gnus-article-mark-to-type type)))
+ (unless (eq mark-type 'tuple)
+ (setf (alist-get type newmarks)
+ (gnus-compress-sequence mark-list)))))
+ ;; and ensure an unexist key.
+ (unless (assq 'unexist newmarks)
+ (push (cons 'unexist nil) newmarks))
+
+ (gnus-info-set-marks info newmarks)
+ (gnus-set-active group (cons 1 (nnselect-artlist-length
+ gnus-newsgroup-selection)))))
+
+
+(deffoo nnselect-request-thread (header &optional group server)
+ (with-current-buffer gnus-summary-buffer
+ (let ((group (nnselect-add-prefix group))
+ ;; find the best group for the originating article. if its a
+ ;; pseudo-article look for real articles in the same thread
+ ;; and see where they come from.
+ (artgroup (nnselect-article-group
+ (if (> (mail-header-number header) 0)
+ (mail-header-number header)
+ (if (> (gnus-summary-article-number) 0)
+ (gnus-summary-article-number)
+ (let ((thread
+ (gnus-id-to-thread (mail-header-id header))))
+ (when thread
+ (cl-some #'(lambda (x)
+ (when (and x (> x 0)) x))
+ (gnus-articles-in-thread thread)))))))))
+ ;; Check if search-based thread referral is permitted, and
+ ;; available.
+ (if (and gnus-refer-thread-use-search
+ (gnus-search-server-to-engine
+ (gnus-method-to-server
+ (gnus-find-method-for-group artgroup))))
+ ;; If so we perform the query, massage the result, and return
+ ;; the new headers back to the caller to incorporate into the
+ ;; current summary buffer.
+ (let* ((group-spec
+ (list (delq nil (list
+ (or server (gnus-group-server artgroup))
+ (unless gnus-refer-thread-use-search
+ artgroup)))))
+ (ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query-spec
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
+ (last (nnselect-artlist-length gnus-newsgroup-selection))
+ (first (1+ last))
+ (new-nnselect-artlist
+ (gnus-search-run-query
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec))))
+ old-arts seq
+ headers)
+ (mapc
+ #'(lambda (article)
+ (if
+ (setq seq
+ (cl-position article
+ gnus-newsgroup-selection :test 'equal))
+ (push (1+ seq) old-arts)
+ (setq gnus-newsgroup-selection
+ (vconcat gnus-newsgroup-selection (vector article)))
+ (cl-incf last)))
+ new-nnselect-artlist)
+ (setq headers
+ (gnus-fetch-headers
+ (append (sort old-arts '<)
+ (number-sequence first last)) nil t))
+ (gnus-group-set-parameter
+ group
+ 'nnselect-artlist
+ (nnselect-compress-artlist gnus-newsgroup-selection))
+ (when (>= last first)
+ (let (new-marks)
+ (pcase-dolist (`(,artgroup . ,artids)
+ (ids-by-group (number-sequence first last)))
+ (pcase-dolist (`(,type . ,marked)
+ (gnus-info-marks (gnus-get-info artgroup)))
+ (setq marked (gnus-uncompress-sequence marked))
+ (when (setq new-marks
+ (delq nil
+ (mapcar
+ #'(lambda (art)
+ (when (memq (cdr art) marked)
+ (car art)))
+ artids)))
+ (nconc
+ (symbol-value
+ (intern
+ (format "gnus-newsgroup-%s"
+ (car (rassq type gnus-article-mark-lists)))))
+ new-marks)))))
+ (setq gnus-newsgroup-active
+ (cons 1 (nnselect-artlist-length gnus-newsgroup-selection)))
+ (gnus-set-active
+ group
+ (cons 1 (nnselect-artlist-length gnus-newsgroup-selection))))
+ headers)
+ ;; If we can't or won't use search, just warp to the original
+ ;; group and punt back to gnus-summary-refer-thread.
+ (and (gnus-warp-to-article) (gnus-summary-refer-thread))))))
+
+
+(deffoo nnselect-close-group (group &optional _server)
+ (let ((group (nnselect-add-prefix group)))
+ (unless gnus-group-is-exiting-without-update-p
+ (nnselect-push-info group))
+ (setq gnus-newsgroup-selection nil)
+ (when (gnus-ephemeral-group-p group)
+ (gnus-kill-ephemeral-group group)
+ (setq gnus-ephemeral-servers
+ (assq-delete-all 'nnselect gnus-ephemeral-servers)))))
+
+
+(deffoo nnselect-request-create-group (group &optional _server args)
+ (message "Creating nnselect group %s" group)
+ (let* ((group (gnus-group-prefixed-name group '(nnselect "nnselect")))
+ (specs (assq 'nnselect-specs args))
+ (function-spec
+ (or (alist-get 'nnselect-function specs)
+ (intern (completing-read "Function: " obarray #'functionp))))
+ (args-spec
+ (or (alist-get 'nnselect-args specs)
+ (read-from-minibuffer "Args: " nil nil t nil "nil")))
+ (nnselect-specs (list (cons 'nnselect-function function-spec)
+ (cons 'nnselect-args args-spec))))
+ (gnus-group-set-parameter group 'nnselect-specs nnselect-specs)
+ (gnus-group-set-parameter
+ group 'nnselect-artlist
+ (nnselect-compress-artlist (or (alist-get 'nnselect-artlist args)
+ (nnselect-run nnselect-specs))))
+ (nnselect-request-update-info group (gnus-get-info group)))
+ t)
+
+
+(deffoo nnselect-request-type (_group &optional article)
+ (if (and (numberp article) (> article 0))
+ (gnus-request-type
+ (nnselect-article-group article) (nnselect-article-number article))
+ 'unknown))
+
+(deffoo nnselect-request-post (&optional _server)
+ (if (not gnus-message-group-art)
+ (nnheader-report 'nnselect "Can't post to an nnselect group")
+ (gnus-request-post
+ (gnus-find-method-for-group
+ (nnselect-article-group (cdr gnus-message-group-art))))))
+
+
+(deffoo nnselect-request-rename-group (_group _new-name &optional _server)
+ t)
+
+
+(deffoo nnselect-request-scan (group _method)
+ (when (and group
+ (gnus-group-get-parameter (nnselect-add-prefix group)
+ 'nnselect-rescan t))
+ (nnselect-request-group-scan group)))
+
+
+(deffoo nnselect-request-group-scan (group &optional _server _info)
+ (let* ((group (nnselect-add-prefix group))
+ (artlist (nnselect-run
+ (gnus-group-get-parameter group 'nnselect-specs t))))
+ (gnus-set-active group (cons 1 (nnselect-artlist-length
+ artlist)))
+ (gnus-group-set-parameter
+ group 'nnselect-artlist
+ (nnselect-compress-artlist artlist))))
+
+;; Add any undefined required backend functions
+
+;; (nnoo-define-skeleton nnselect)
+
+;;; Util Code:
+
+(defun gnus-nnselect-group-p (group)
+ "Say whether GROUP is nnselect or not."
+ (or (and (gnus-group-prefixed-p group)
+ (eq 'nnselect (car (gnus-find-method-for-group group))))
+ (eq 'nnselect (car gnus-command-method))))
+
+
+(defun nnselect-run (specs)
+ "Apply nnselect-function to nnselect-args from SPECS.
+Return an article list."
+ (let ((func (alist-get 'nnselect-function specs))
+ (args (alist-get 'nnselect-args specs)))
+ (condition-case err
+ (funcall func args)
+ (error (gnus-error 3 "nnselect-run: %s on %s gave error %s" func args err)
+ []))))
+
+(defun nnselect-search-thread (header)
+ "Make an nnselect group containing the thread with article HEADER.
+The current server will be searched. If the registry is
+installed, the server that the registry reports the current
+article came from is also searched."
+ (let* ((ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
+ (server
+ (list (list (gnus-method-to-server
+ (gnus-find-method-for-group gnus-newsgroup-name)))))
+ (registry-group (and
+ (bound-and-true-p gnus-registry-enabled)
+ (car (gnus-registry-get-id-key
+ (mail-header-id header) 'group))))
+ (registry-server
+ (and registry-group
+ (gnus-method-to-server
+ (gnus-find-method-for-group registry-group)))))
+ (when registry-server (cl-pushnew (list registry-server) server
+ :test 'equal))
+ (gnus-group-read-ephemeral-group
+ (concat "nnselect-" (message-unique-id))
+ (list 'nnselect "nnselect")
+ nil
+ (cons (current-buffer) gnus-current-window-configuration)
+ ; nil
+ nil nil
+ (list
+ (cons 'nnselect-specs
+ (list
+ (cons 'nnselect-function 'gnus-search-run-query)
+ (cons 'nnselect-args
+ (list (cons 'search-query-spec query)
+ (cons 'search-group-spec server)))))
+ (cons 'nnselect-artlist nil)))
+ (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
+
+
+
+(defun nnselect-push-info (group)
+ "Copy mark-lists from GROUP to the originating groups."
+ (let ((select-unreads (numbers-by-group gnus-newsgroup-unreads))
+ (select-reads (numbers-by-group
+ (gnus-info-read (gnus-get-info group)) 'range))
+ (select-unseen (numbers-by-group gnus-newsgroup-unseen))
+ (gnus-newsgroup-active nil) mark-list)
+ ;; collect the set of marked article lists categorized by
+ ;; originating groups
+ (pcase-dolist (`(,mark . ,type) gnus-article-mark-lists)
+ (let (type-list)
+ (when (setq type-list
+ (symbol-value (intern (format "gnus-newsgroup-%s" mark))))
+ (push (cons
+ type
+ (numbers-by-group type-list (gnus-article-mark-to-type type)))
+ mark-list))))
+ ;; now work on each originating group one at a time
+ (pcase-dolist (`(,artgroup . ,artlist)
+ (numbers-by-group gnus-newsgroup-articles))
+ (let* ((group-info (gnus-get-info artgroup))
+ (old-unread (gnus-list-of-unread-articles artgroup))
+ newmarked delta-marks)
+ (when group-info
+ ;; iterate over mark lists for this group
+ (pcase-dolist (`(,_mark . ,type) gnus-article-mark-lists)
+ (let ((list (cdr (assoc artgroup (alist-get type mark-list))))
+ (mark-type (gnus-article-mark-to-type type)))
+
+ ;; When the backend can store marks we collect any
+ ;; changes. Unlike a normal group the mark lists only
+ ;; include marks for articles we retrieved.
+ (when (and (gnus-check-backend-function
+ 'request-set-mark artgroup)
+ (not (gnus-article-unpropagatable-p type)))
+ (let* ((old (gnus-list-range-intersection
+ artlist
+ (alist-get type (gnus-info-marks group-info))))
+ (del (gnus-remove-from-range (copy-tree old) list))
+ (add (gnus-remove-from-range (copy-tree list) old)))
+ (when add (push (list add 'add (list type)) delta-marks))
+ (when del
+ ;; Don't delete marks from outside the active range.
+ ;; This shouldn't happen, but is a sanity check.
+ (setq del (gnus-sorted-range-intersection
+ (gnus-active artgroup) del))
+ (push (list del 'del (list type)) delta-marks))))
+
+ ;; Marked sets are of mark-type 'tuple, 'list, or
+ ;; 'range. We merge the lists with what is already in
+ ;; the original info to get full list of new marks. We
+ ;; do this by removing all the articles we retrieved
+ ;; from the full list, and then add back in the newly
+ ;; marked ones.
+ (cond
+ ((eq mark-type 'tuple)
+ ;; Get rid of the entries that have the default
+ ;; score.
+ (when (and list (eq type 'score) gnus-save-score)
+ (let* ((arts list)
+ (prev (cons nil list))
+ (all prev))
+ (while arts
+ (if (or (not (consp (car arts)))
+ (= (cdar arts) gnus-summary-default-score))
+ (setcdr prev (cdr arts))
+ (setq prev arts))
+ (setq arts (cdr arts)))
+ (setq list (cdr all))))
+ ;; now merge with the original list and sort just to
+ ;; make sure
+ (setq list
+ (sort (map-merge
+ 'list list
+ (alist-get type (gnus-info-marks group-info)))
+ (lambda (elt1 elt2)
+ (< (car elt1) (car elt2))))))
+ (t
+ (setq list
+ (gnus-compress-sequence
+ (gnus-sorted-union
+ (gnus-sorted-difference
+ (gnus-uncompress-sequence
+ (alist-get type (gnus-info-marks group-info)))
+ artlist)
+ (sort list #'<)) t)))
+
+ ;; When exiting the group, everything that's previously been
+ ;; unseen is now seen.
+ (when (eq type 'seen)
+ (setq list (gnus-range-add
+ list (cdr (assoc artgroup select-unseen))))))
+
+ (when (or list (eq type 'unexist))
+ (push (cons type list) newmarked)))) ;; end of mark-type loop
+
+ (when delta-marks
+ (unless (gnus-check-group artgroup)
+ (error "Can't open server for %s" artgroup))
+ (gnus-request-set-mark artgroup delta-marks))
+
+ (gnus-atomic-progn
+ (gnus-info-set-marks group-info newmarked)
+ ;; Cut off the end of the info if there's nothing else there.
+ (let ((i 5))
+ (while (and (> i 2)
+ (not (nth i group-info)))
+ (when (nthcdr (cl-decf i) group-info)
+ (setcdr (nthcdr i group-info) nil))))
+
+ ;; update read and unread
+ (gnus-update-read-articles
+ artgroup
+ (gnus-uncompress-range
+ (gnus-add-to-range
+ (gnus-remove-from-range
+ old-unread
+ (cdr (assoc artgroup select-reads)))
+ (sort (cdr (assoc artgroup select-unreads)) '<))))
+ (gnus-get-unread-articles-in-group
+ group-info (gnus-active artgroup) t)
+ (gnus-group-update-group artgroup t t)))))))
+
+
+(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
+
+(defun gnus-summary-make-search-group (no-parse)
+ "Search a group from the summary buffer.
+Pass NO-PARSE on to the search engine."
+ (interactive "P")
+ (gnus-warp-to-article)
+ (let ((spec
+ (list
+ (cons 'search-group-spec
+ (list (list
+ (gnus-group-server gnus-newsgroup-name)
+ gnus-newsgroup-name))))))
+ (gnus-group-make-search-group no-parse spec)))
+
+
+;; The end.
+(provide 'nnselect)
+
+;;; nnselect.el ends here
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el
index 33b68fa989e..0b6bba5fea7 100644
--- a/lisp/gnus/nnspool.el
+++ b/lisp/gnus/nnspool.el
@@ -422,7 +422,7 @@ there.")
(nnspool-article-pathname nnspool-current-group article))
(nnheader-insert-article-line article)
(goto-char (point-min))
- (let ((headers (nnheader-parse-head)))
+ (let ((headers (nnheader-parse-head nil t)))
(set-buffer cur)
(goto-char (point-max))
(nnheader-insert-nov headers)))
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 6ce8724cbbb..a5c82447926 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -309,7 +309,7 @@ backend doesn't catch this error.")
(defun nntp-record-command (string)
"Record the command STRING."
- (with-current-buffer (get-buffer-create "*nntp-log*")
+ (with-current-buffer (gnus-get-buffer-create "*nntp-log*")
(goto-char (point-max))
(insert (format-time-string "%Y%m%dT%H%M%S.%3N")
" " nntp-address " " string "\n")))
@@ -1247,8 +1247,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(and nntp-connection-timeout
(run-at-time
nntp-connection-timeout nil
- `(lambda ()
- (nntp-kill-buffer ,pbuffer)))))
+ (lambda ()
+ (nntp-kill-buffer pbuffer)))))
(process
(condition-case err
(let ((coding-system-for-read 'binary)
@@ -1263,7 +1263,17 @@ If SEND-IF-FORCE, only send authinfo to the server if the
"nntpd" pbuffer nntp-address nntp-port-number
:type (cadr (assoc nntp-open-connection-function map))
:end-of-command "^\\([2345]\\|[.]\\).*\n"
- :capability-command "HELP\r\n"
+ :capability-command
+ (lambda (greeting)
+ (if (and greeting
+ (string-match "Typhoon" greeting))
+ ;; Certain versions of the Typhoon server
+ ;; doesn't understand the CAPABILITIES
+ ;; command, but includes the capability
+ ;; data in the HELP command instead.
+ "HELP\r\n"
+ ;; Use the correct command for everything else.
+ "CAPABILITIES\r\n"))
:success "^3"
:starttls-function
(lambda (capabilities)
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index e1290a9c774..54c2f7be820 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -97,7 +97,7 @@ component group will show up when you enter the virtual group.")
(if (stringp (car articles))
'headers
(let ((vbuf (nnheader-set-temp-buffer
- (get-buffer-create " *virtual headers*")))
+ (gnus-get-buffer-create " *virtual headers*")))
(carticles (nnvirtual-partition-sequence articles))
(sysname (system-name))
cgroup carticle article result prefix)
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index d41f32801ee..3edae04fcc0 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -44,6 +44,7 @@
;; cry ;-(
;; dead X-)
;; grin :-D
+;; halo O:-)
;;; Code:
@@ -56,18 +57,16 @@
(defvar smiley-data-directory)
-(defcustom smiley-style
- (if (and (fboundp 'face-attribute)
- ;; In batch mode, attributes can be unspecified.
- (condition-case nil
- (>= (face-attribute 'default :height) 160)
- (error nil)))
- 'medium
- 'low-color)
+;; In batch mode, attributes can be unspecified.
+(defcustom smiley-style (if (ignore-errors
+ (>= (face-attribute 'default :height) 160))
+ 'medium
+ 'low-color)
"Smiley style."
:type '(choice (const :tag "small, 3 colors" low-color) ;; 13x14
(const :tag "medium, ~10 colors" medium) ;; 16x16
- (const :tag "dull, grayscale" grayscale)) ;; 14x14
+ (const :tag "dull, grayscale" grayscale) ;; 14x14
+ (const :tag "emoji, full color" emoji))
:set (lambda (symbol value)
(set-default symbol value)
(setq smiley-data-directory (smiley-directory))
@@ -99,6 +98,35 @@ is nil, use `smiley-style'."
:type 'directory
:group 'smiley)
+(defcustom smiley-emoji-regexp-alist
+ '(("\\(;-)\\)\\W" 1 "😉")
+ ("[^;]\\(;)\\)\\W" 1 "😉")
+ ("\\(:-]\\)\\W" 1 "😬")
+ ("\\(8-)\\)\\W" 1 "🥴")
+ ("\\(:-|\\)\\W" 1 "ðŸ˜")
+ ("\\(:-[/\\]\\)\\W" 1 "😕")
+ ("\\(:-(\\)\\W" 1 "😠")
+ ("\\(X-)\\)\\W" 1 "😵") ; 💀
+ ("\\(:-{\\)\\W" 1 "😦")
+ ("\\(>:-)\\)\\W" 1 "😈")
+ ("\\(;-(\\)\\W" 1 "😢")
+ ("\\(:-D\\)\\W" 1 "😀")
+ ("\\(O:-)\\)\\W" 1 "😇")
+ ;; "smile" must be come after "evil"
+ ("\\(\\^?:-?)\\)\\W" 1 "🙂"))
+ "A list of regexps to map smilies to emoji.
+The elements are (REGEXP MATCH EMOJI), where MATCH is the submatch in
+regexp to replace with EMOJI."
+ :version "28.1"
+ :type '(repeat (list regexp
+ (integer :tag "Regexp match number")
+ (string :tag "Emoji")))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (smiley-update-cache))
+ :initialize 'custom-initialize-default
+ :group 'smiley)
+
;; The XEmacs version has a baroque, if not rococo, set of these.
(defcustom smiley-regexp-alist
'(("\\(;-)\\)\\W" 1 "blink")
@@ -145,23 +173,25 @@ regexp to replace with IMAGE. IMAGE is the name of an image file in
(defun smiley-update-cache ()
(setq smiley-cached-regexp-alist nil)
- (dolist (elt (if (symbolp smiley-regexp-alist)
- (symbol-value smiley-regexp-alist)
- smiley-regexp-alist))
- (let ((types gnus-smiley-file-types)
- file type)
- (while (and (not file)
- (setq type (pop types)))
- (unless (file-exists-p
- (setq file (expand-file-name (concat (nth 2 elt) "." type)
- smiley-data-directory)))
- (setq file nil)))
- (when type
- (let ((image (gnus-create-image file (intern type) nil
- :ascent 'center)))
- (when image
- (push (list (car elt) (cadr elt) image)
- smiley-cached-regexp-alist)))))))
+ (if (eq smiley-style 'emoji)
+ (setq smiley-cached-regexp-alist smiley-emoji-regexp-alist)
+ (dolist (elt (if (symbolp smiley-regexp-alist)
+ (symbol-value smiley-regexp-alist)
+ smiley-regexp-alist))
+ (let ((types gnus-smiley-file-types)
+ file type)
+ (while (and (not file)
+ (setq type (pop types)))
+ (unless (file-exists-p
+ (setq file (expand-file-name (concat (nth 2 elt) "." type)
+ smiley-data-directory)))
+ (setq file nil)))
+ (when type
+ (let ((image (gnus-create-image file (intern type) nil
+ :ascent 'center)))
+ (when image
+ (push (list (car elt) (cadr elt) image)
+ smiley-cached-regexp-alist))))))))
;; Not implemented:
;; (defvar smiley-mouse-map
@@ -193,8 +223,15 @@ A list of images is returned."
(when image
(push image images)
(gnus-add-wash-type 'smiley)
- (gnus-add-image 'smiley image)
- (gnus-put-image image string 'smiley))))
+ (if (symbolp image)
+ (progn
+ (gnus-add-image 'smiley image)
+ (gnus-put-image image string 'smiley))
+ ;; This is a string, but mark the property for
+ ;; deletion if the washing method is switched off.
+ (insert (propertize string
+ 'display image
+ 'gnus-image-category 'smiley))))))
images))))
;;;###autoload
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index fe6daf6b037..eb27fee88ce 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -174,8 +174,9 @@ and the files themselves should be in PEM format."
(eq 0 (call-process "openssl" nil nil nil "version"))
(error nil))
"openssl")
- "Name of OpenSSL binary."
- :type 'string
+ "Name of OpenSSL binary or nil if none."
+ :type '(choice string
+ (const :tag "none" nil))
:group 'smime)
;; OpenSSL option to select the encryption cipher
@@ -185,6 +186,9 @@ and the files themselves should be in PEM format."
:version "22.1"
:type '(choice (const :tag "Triple DES" "-des3")
(const :tag "DES" "-des")
+ (const :tag "AES 256 bits" "-aes256")
+ (const :tag "AES 192 bits" "-aes192")
+ (const :tag "AES 128 bits" "-aes128")
(const :tag "RC2 40 bits" "-rc2-40")
(const :tag "RC2 64 bits" "-rc2-64")
(const :tag "RC2 128 bits" "-rc2-128"))
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index 3da45a2b623..bf593865d72 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -4,7 +4,7 @@
;; Author: Alex Schroeder <alex@gnu.org>
;; Keywords: network
-;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SpamStat
+;; URL: https://www.emacswiki.org/cgi-bin/wiki.pl?SpamStat
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 5632bdaf250..96a7da2313c 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -579,7 +579,7 @@ This must be a list. For example, `(\"-C\" \"configfile\")'."
(defcustom spam-spamassassin-positive-spam-flag-header "YES"
"The regex on `spam-spamassassin-spam-flag-header' for positive spam
identification."
- :type 'string
+ :type 'regexp
:group 'spam-spamassassin)
(defcustom spam-spamassassin-spam-status-header "X-Spam-Status"
diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el
index dead1f6bf77..1d9e051a8cf 100644
--- a/lisp/help-at-pt.el
+++ b/lisp/help-at-pt.el
@@ -92,13 +92,16 @@ the `kbd-help' property at point. If `kbd-help' does not produce
a string, but the `help-echo' property does, then that string is
printed instead.
+The string is passed through `substitute-command-keys' before it
+is displayed.
+
A numeric argument ARG prevents display of a message in case
there is no help. While ARG can be used interactively, it is
mainly meant for use from Lisp."
(interactive "P")
(let ((help (help-at-pt-kbd-string)))
(if help
- (message "%s" help)
+ (message "%s" (substitute-command-keys help))
(if (not arg) (message "No local help at point")))))
(defvar help-at-pt-timer nil
@@ -162,6 +165,10 @@ included in this list. Suggested properties are `keymap',
`local-map', `button' and `kbd-help'. Any value other than t or
a non-empty list disables the feature.
+The text printed from the `help-echo' property is often only
+relevant when using the mouse. The presence of a `kbd-help'
+property guarantees that non mouse specific help is available.
+
This variable only takes effect after a call to
`help-at-pt-set-timer'. The help gets printed after Emacs has
been idle for `help-at-pt-timer-delay' seconds. You can call
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index c7d0112cb61..170f497541a 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -40,8 +40,8 @@
(defvar help-fns-describe-function-functions nil
"List of functions to run in help buffer in `describe-function'.
Those functions will be run after the header line and argument
-list was inserted, and before the documentation will be inserted.
-The functions will receive the function name as argument.
+list was inserted, and before the documentation is inserted.
+The functions will be called with one argument: the function's symbol.
They can assume that a newline was output just before they were called,
and they should terminate any of their own output with a newline.
By convention they should indent their output by 2 spaces.")
@@ -151,9 +151,7 @@ When called from lisp, FUNCTION may also be a function object."
(let* ((fn (function-called-at-point))
(enable-recursive-minibuffers t)
(val (completing-read
- (if fn
- (format "Describe function (default %s): " fn)
- "Describe function: ")
+ (format-prompt "Describe function" fn)
#'help--symbol-completion-table
(lambda (f) (or (fboundp f) (get f 'function-documentation)))
t nil nil
@@ -364,6 +362,7 @@ suitable file is found, return nil."
(help-C-file-name type 'subr)
'C-source))
((and (not file-name) (symbolp object)
+ (eq type 'defvar)
(integerp (get object 'variable-documentation)))
;; A variable defined in C. The form is from `describe-variable'.
(if (get-buffer " *DOC*")
@@ -623,7 +622,7 @@ FILE is the file where FUNCTION was probably defined."
;; of the *packages* in which the function is defined.
(let* ((name (symbol-name symbol))
(re (concat "\\_<" (regexp-quote name) "\\_>"))
- (news (directory-files data-directory t "\\`NEWS\\.[1-9]"))
+ (news (directory-files data-directory t "\\`NEWS\\($\\|\\.\\)"))
(place nil)
(first nil))
(with-temp-buffer
@@ -647,8 +646,7 @@ FILE is the file where FUNCTION was probably defined."
(setq place (list f pos))
(setq first version)))))))))
(when first
- (make-text-button first nil 'type 'help-news 'help-args place))
- first))
+ (make-text-button first nil 'type 'help-news 'help-args place))))
(add-hook 'help-fns-describe-function-functions
#'help-fns--mention-first-release)
@@ -661,6 +659,39 @@ FILE is the file where FUNCTION was probably defined."
(insert (format " Probably introduced at or before Emacs version %s.\n"
first))))))
+(declare-function shortdoc-display-group "shortdoc")
+(declare-function shortdoc-function-groups "shortdoc")
+
+(add-hook 'help-fns-describe-function-functions
+ #'help-fns--mention-shortdoc-groups)
+(defun help-fns--mention-shortdoc-groups (object)
+ (require 'shortdoc)
+ (when-let ((groups (and (symbolp object)
+ (shortdoc-function-groups object))))
+ (let ((start (point))
+ (times 0))
+ (with-current-buffer standard-output
+ (insert " Other relevant functions are documented in the ")
+ (mapc
+ (lambda (group)
+ (when (> times 0)
+ (insert (if (= times (1- (length groups)))
+ " and "
+ ", ")))
+ (setq times (1+ times))
+ (insert-text-button
+ (symbol-name group)
+ 'action (lambda (_)
+ (shortdoc-display-group group))))
+ groups)
+ (insert (if (= (length groups) 1)
+ " group.\n"
+ " groups.\n")))
+ (save-restriction
+ (narrow-to-region start (point))
+ (fill-region-as-paragraph (point-min) (point-max))
+ (goto-char (point-max))))))
+
(defun help-fns-short-filename (filename)
(let* ((abbrev (abbreviate-file-name filename))
(short abbrev))
@@ -893,7 +924,7 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
(output nil))
(if custom-version
(setq output
- (format "This %s was introduced, or its default value was changed, in\nversion %s of Emacs.\n"
+ (format " This %s was introduced, or its default value was changed, in\n version %s of Emacs.\n"
type custom-version))
(when cpv
(let* ((package (car-safe cpv))
@@ -904,7 +935,7 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
(emacsv (cdr (assoc version pkg-versions))))
(if (and package version)
(setq output
- (format (concat "This %s was introduced, or its default value was changed, in\nversion %s of the %s package"
+ (format (concat " This %s was introduced, or its default value was changed, in\n version %s of the %s package"
(if emacsv
(format " that is part of Emacs %s" emacsv))
".\n")
@@ -924,10 +955,7 @@ it is displayed along with the global value."
(orig-buffer (current-buffer))
val)
(setq val (completing-read
- (if (symbolp v)
- (format
- "Describe variable (default %s): " v)
- "Describe variable: ")
+ (format-prompt "Describe variable" (and (symbolp v) v))
#'help--symbol-completion-table
(lambda (vv)
;; In case the variable only exists in the buffer
@@ -944,7 +972,7 @@ it is displayed along with the global value."
(unless (buffer-live-p buffer) (setq buffer (current-buffer)))
(unless (frame-live-p frame) (setq frame (selected-frame)))
(if (not (symbolp variable))
- (message "You did not specify a variable")
+ (user-error "You didn't specify a variable")
(save-excursion
(let ((valvoid (not (with-current-buffer buffer (boundp variable))))
val val-start-pos locus)
@@ -968,7 +996,7 @@ it is displayed along with the global value."
" is a variable defined in `%s'.\n"
(if (eq file-name 'C-source)
"C source code"
- (file-name-nondirectory file-name))))
+ (help-fns-short-filename file-name))))
(with-current-buffer standard-output
(save-excursion
(re-search-backward (substitute-command-keys
@@ -1125,8 +1153,8 @@ it is displayed along with the global value."
;; Note variable's version or package version.
(let ((output (describe-variable-custom-version-info variable)))
(when output
- (terpri)
- (terpri)
+ ;; (terpri)
+ ;; (terpri)
(princ output)))))
(add-hook 'help-fns-describe-variable-functions #'help-fns--var-safe-local)
@@ -1352,7 +1380,7 @@ If FRAME is omitted or nil, use the selected frame."
(setq file-name (find-lisp-object-file-name f 'defface))
(when file-name
(princ (substitute-command-keys "Defined in `"))
- (princ (file-name-nondirectory file-name))
+ (princ (help-fns-short-filename file-name))
(princ (substitute-command-keys "'"))
;; Make a hyperlink to the library.
(save-excursion
@@ -1424,10 +1452,8 @@ current buffer and the selected frame, respectively."
(v-or-f (if found v-or-f (function-called-at-point)))
(found (or found v-or-f))
(enable-recursive-minibuffers t)
- (val (completing-read (if found
- (format
- "Describe symbol (default %s): " v-or-f)
- "Describe symbol: ")
+ (val (completing-read (format-prompt "Describe symbol"
+ (and found v-or-f))
#'help--symbol-completion-table
(lambda (vv)
(cl-some (lambda (x) (funcall (nth 1 x) vv))
@@ -1435,7 +1461,7 @@ current buffer and the selected frame, respectively."
t nil nil
(if found (symbol-name v-or-f)))))
(list (if (equal val "")
- v-or-f (intern val)))))
+ (or v-or-f "") (intern val)))))
(if (not (symbolp symbol))
(user-error "You didn't specify a function or variable"))
(unless (buffer-live-p buffer) (setq buffer (current-buffer)))
@@ -1564,7 +1590,256 @@ BUFFER should be a buffer or a buffer name."
(insert "\nThe parent category table is:")
(describe-vector table 'help-describe-category-set))))))
+(defun help-fns-find-keymap-name (keymap)
+ "Find the name of the variable with value KEYMAP.
+Return nil if KEYMAP is not a valid keymap, or if there is no
+variable with value KEYMAP."
+ (when (keymapp keymap)
+ (let ((name (catch 'found-keymap
+ (mapatoms (lambda (symb)
+ (when (and (boundp symb)
+ (eq (symbol-value symb) keymap)
+ (not (eq symb 'keymap))
+ (throw 'found-keymap symb)))))
+ nil)))
+ ;; Follow aliasing.
+ (or (ignore-errors (indirect-variable name)) name))))
+
+(defun help-fns--most-relevant-active-keymap ()
+ "Return the name of the most relevant active keymap.
+The heuristic to determine which keymap is most likely to be
+relevant to a user follows this order:
+
+1. 'keymap' text property at point
+2. 'local-map' text property at point
+3. the `current-local-map'
+
+This is used to set the default value for the interactive prompt
+in `describe-keymap'. See also `Searching the Active Keymaps'."
+ (help-fns-find-keymap-name (or (get-char-property (point) 'keymap)
+ (if (get-text-property (point) 'local-map)
+ (get-char-property (point) 'local-map)
+ (current-local-map)))))
+
+;;;###autoload
+(defun describe-keymap (keymap)
+ "Describe key bindings in KEYMAP.
+When called interactively, prompt for a variable that has a
+keymap value."
+ (interactive
+ (let* ((km (help-fns--most-relevant-active-keymap))
+ (val (completing-read
+ (format-prompt "Keymap" km)
+ obarray
+ (lambda (m) (and (boundp m) (keymapp (symbol-value m))))
+ t nil 'keymap-name-history
+ (symbol-name km))))
+ (unless (equal val "")
+ (setq km (intern val)))
+ (unless (and km (keymapp (symbol-value km)))
+ (user-error "Not a keymap: %s" km))
+ (list km)))
+ (let (used-gentemp)
+ (unless (and (symbolp keymap)
+ (boundp keymap)
+ (keymapp (symbol-value keymap)))
+ (when (not (keymapp keymap))
+ (if (symbolp keymap)
+ (error "Not a keymap variable: %S" keymap)
+ (error "Not a keymap")))
+ (let ((sym nil))
+ (unless sym
+ (setq sym (cl-gentemp "KEYMAP OBJECT (no variable) "))
+ (setq used-gentemp t)
+ (set sym keymap))
+ (setq keymap sym)))
+ ;; Follow aliasing.
+ (setq keymap (or (ignore-errors (indirect-variable keymap)) keymap))
+ (help-setup-xref (list #'describe-keymap keymap)
+ (called-interactively-p 'interactive))
+ (let* ((name (symbol-name keymap))
+ (doc (documentation-property keymap 'variable-documentation))
+ (file-name (find-lisp-object-file-name keymap 'defvar)))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (unless used-gentemp
+ (princ (format-message "%S is a keymap variable" keymap))
+ (if (not file-name)
+ (princ ".\n\n")
+ (princ (format-message
+ " defined in `%s'.\n\n"
+ (if (eq file-name 'C-source)
+ "C source code"
+ (help-fns-short-filename file-name))))
+ (save-excursion
+ (re-search-backward (substitute-command-keys
+ "`\\([^`']+\\)'")
+ nil t)
+ (help-xref-button 1 'help-variable-def
+ keymap file-name))))
+ (when (and (not (equal "" doc)) doc)
+ (princ "Documentation:\n")
+ (princ (format-message "%s\n\n" doc)))
+ ;; Use `insert' instead of `princ', so control chars (e.g. \377)
+ ;; insert correctly.
+ (insert (substitute-command-keys (concat "\\{" name "}"))))))
+ ;; Cleanup.
+ (when used-gentemp
+ (makunbound keymap))))
+;;;###autoload
+(defun describe-mode (&optional buffer)
+ "Display documentation of current major mode and minor modes.
+A brief summary of the minor modes comes first, followed by the
+major mode description. This is followed by detailed
+descriptions of the minor modes, each on a separate page.
+
+For this to work correctly for a minor mode, the mode's indicator
+variable \(listed in `minor-mode-alist') must also be a function
+whose documentation describes the minor mode.
+
+If called from Lisp with a non-nil BUFFER argument, display
+documentation for the major and minor modes of that buffer."
+ (interactive "@")
+ (unless buffer (setq buffer (current-buffer)))
+ (help-setup-xref (list #'describe-mode buffer)
+ (called-interactively-p 'interactive))
+ ;; For the sake of help-do-xref and help-xref-go-back,
+ ;; don't switch buffers before calling `help-buffer'.
+ (with-help-window (help-buffer)
+ (with-current-buffer buffer
+ (let (minor-modes)
+ ;; Older packages do not register in minor-mode-list but only in
+ ;; minor-mode-alist.
+ (dolist (x minor-mode-alist)
+ (setq x (car x))
+ (unless (memq x minor-mode-list)
+ (push x minor-mode-list)))
+ ;; Find enabled minor mode we will want to mention.
+ (dolist (mode minor-mode-list)
+ ;; Document a minor mode if it is listed in minor-mode-alist,
+ ;; non-nil, and has a function definition.
+ (let ((fmode (or (get mode :minor-mode-function) mode)))
+ (and (boundp mode) (symbol-value mode)
+ (fboundp fmode)
+ (let ((pretty-minor-mode
+ (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
+ (symbol-name fmode))
+ (capitalize
+ (substring (symbol-name fmode)
+ 0 (match-beginning 0)))
+ fmode)))
+ (push (list fmode pretty-minor-mode
+ (format-mode-line (assq mode minor-mode-alist)))
+ minor-modes)))))
+ ;; Narrowing is not a minor mode, but its indicator is part of
+ ;; mode-line-modes.
+ (when (buffer-narrowed-p)
+ (push '(narrow-to-region "Narrow" " Narrow") minor-modes))
+ (setq minor-modes
+ (sort minor-modes
+ (lambda (a b) (string-lessp (cadr a) (cadr b)))))
+ (when minor-modes
+ (princ "Enabled minor modes:\n")
+ (make-local-variable 'help-button-cache)
+ (with-current-buffer standard-output
+ (dolist (mode minor-modes)
+ (let ((mode-function (nth 0 mode))
+ (pretty-minor-mode (nth 1 mode))
+ (indicator (nth 2 mode)))
+ (save-excursion
+ (goto-char (point-max))
+ (princ "\n\f\n")
+ (push (point-marker) help-button-cache)
+ ;; Document the minor modes fully.
+ (insert-text-button
+ pretty-minor-mode 'type 'help-function
+ 'help-args (list mode-function)
+ 'button '(t))
+ (princ (format " minor mode (%s):\n"
+ (if (zerop (length indicator))
+ "no indicator"
+ (format "indicator%s"
+ indicator))))
+ (princ (help-split-fundoc (documentation mode-function)
+ nil 'doc)))
+ (insert-button pretty-minor-mode
+ 'action (car help-button-cache)
+ 'follow-link t
+ 'help-echo "mouse-2, RET: show full information")
+ (newline)))
+ (forward-line -1)
+ (fill-paragraph nil)
+ (forward-line 1))
+
+ (princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
+ ;; Document the major mode.
+ (let ((mode mode-name))
+ (with-current-buffer standard-output
+ (let ((start (point)))
+ (insert (format-mode-line mode nil nil buffer))
+ (add-text-properties start (point) '(face bold)))))
+ (princ " mode")
+ (let* ((mode major-mode)
+ (file-name (find-lisp-object-file-name mode nil)))
+ (when file-name
+ (princ (format-message " defined in `%s'"
+ (help-fns-short-filename file-name)))
+ ;; Make a hyperlink to the library.
+ (with-current-buffer standard-output
+ (save-excursion
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
+ nil t)
+ (help-xref-button 1 'help-function-def mode file-name)))))
+ (princ ":\n")
+ (princ (help-split-fundoc (documentation major-mode) nil 'doc)))))
+ ;; For the sake of IELM and maybe others
+ nil)
+
+;; Widgets.
+
+(defvar describe-widget-functions
+ '(button-describe widget-describe)
+ "A list of functions for `describe-widget' to call.
+Each function should take one argument, a buffer position, and return
+non-nil if it described a widget at that position.")
+
+;;;###autoload
+(defun describe-widget (&optional pos)
+ "Display a buffer with information about a widget.
+You can use this command to describe buttons (e.g., the links in a *Help*
+buffer), editable fields of the customization buffers, etc.
+
+Interactively, click on a widget to describe it, or hit RET to describe the
+widget at point.
+
+When called from Lisp, POS may be a buffer position or a mouse position list.
+
+Calls each function of the list `describe-widget-functions' in turn, until
+one of them returns non-nil."
+ (interactive
+ (list
+ (let ((key
+ (read-key
+ "Click on a widget, or hit RET to describe the widget at point")))
+ (cond ((eq key ?\C-m) (point))
+ ((and (mouse-event-p key)
+ (eq (event-basic-type key) 'mouse-1)
+ (equal (event-modifiers key) '(click)))
+ (event-end key))
+ ((eq key ?\C-g) (signal 'quit nil))
+ (t (user-error "You didn't specify a widget"))))))
+ (let (buf)
+ ;; Allow describing a widget in a different window.
+ (when (posnp pos)
+ (setq buf (window-buffer (posn-window pos))
+ pos (posn-point pos)))
+ (with-current-buffer (or buf (current-buffer))
+ (unless (cl-some (lambda (fun) (when (fboundp fun) (funcall fun pos)))
+ describe-widget-functions)
+ (message "No widget found at that position")))))
+
+
;;; Replacements for old lib-src/ programs. Don't seem especially useful.
;; Replaces lib-src/digest-doc.c.
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index bae8281147a..f0770fb6602 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -1,4 +1,4 @@
-;;; help-mode.el --- `help-mode' used by *Help* buffers
+;;; help-mode.el --- `help-mode' used by *Help* buffers -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1993-1994, 1998-2020 Free Software
;; Foundation, Inc.
@@ -47,10 +47,10 @@
(define-key map "\C-c\C-c" 'help-follow-symbol)
(define-key map "\r" 'help-follow)
map)
- "Keymap for help mode.")
+ "Keymap for Help mode.")
(easy-menu-define help-mode-menu help-mode-map
- "Menu for Help Mode."
+ "Menu for Help mode."
'("Help-Mode"
["Show Help for Symbol" help-follow-symbol
:help "Show the docs for the symbol at point"]
@@ -308,7 +308,7 @@ The format is (FUNCTION ARGS...).")
:supertype 'help-xref
'help-function
(lambda (file pos)
- (pop-to-buffer (find-file-noselect file))
+ (view-buffer-other-window (find-file-noselect file))
(goto-char pos))
'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement"))
@@ -327,13 +327,13 @@ Commands:
;;;###autoload
(defun help-mode-setup ()
- "Enter Help Mode in the current buffer."
+ "Enter Help mode in the current buffer."
(help-mode)
(setq buffer-read-only nil))
;;;###autoload
(defun help-mode-finish ()
- "Finalize Help Mode setup in current buffer."
+ "Finalize Help mode setup in current buffer."
(when (derived-mode-p 'help-mode)
(setq buffer-read-only t)
(help-make-xrefs (current-buffer))))
@@ -719,7 +719,8 @@ a proper [back] button."
;; There is a reference at point. Follow it.
(let ((help-xref-following t))
(apply function (if (eq function 'info)
- (append args (list (generate-new-buffer-name "*info*"))) args))))
+ (append args (list (generate-new-buffer-name "*info*")))
+ args))))
;; The doc string is meant to explain what buttons do.
(defun help-follow-mouse ()
@@ -755,16 +756,15 @@ Show all docs for that symbol as either a variable, function or face."
(help-do-xref pos #'describe-symbol (list sym))
(user-error "No symbol here"))))
-(defun help-mode-revert-buffer (_ignore-auto noconfirm)
- (when (or noconfirm (yes-or-no-p "Revert help buffer? "))
- (let ((pos (point))
- (item help-xref-stack-item)
- ;; Pretend there is no current item to add to the history.
- (help-xref-stack-item nil)
- ;; Use the current buffer.
- (help-xref-following t))
- (apply (car item) (cdr item))
- (goto-char pos))))
+(defun help-mode-revert-buffer (_ignore-auto _noconfirm)
+ (let ((pos (point))
+ (item help-xref-stack-item)
+ ;; Pretend there is no current item to add to the history.
+ (help-xref-stack-item nil)
+ ;; Use the current buffer.
+ (help-xref-following t))
+ (apply (car item) (cdr item))
+ (goto-char pos)))
(defun help-insert-string (string)
"Insert STRING to the help buffer and install xref info for it.
diff --git a/lisp/help.el b/lisp/help.el
index c276c1dc280..ac5c2f1311b 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -101,6 +101,7 @@
(define-key map "p" 'finder-by-keyword)
(define-key map "P" 'describe-package)
(define-key map "r" 'info-emacs-manual)
+ (define-key map "R" 'info-display-manual)
(define-key map "s" 'describe-syntax)
(define-key map "t" 'help-with-tutorial)
(define-key map "w" 'where-is)
@@ -131,7 +132,6 @@ This is a list
(WINDOW . quit-window) do quit-window, then select WINDOW.
(WINDOW BUF START POINT) display BUF at START, POINT, then select WINDOW.")
-(define-obsolete-function-alias 'print-help-return-message 'help-print-return-message "23.2")
(defun help-print-return-message (&optional function)
"Display or return message saying how to restore windows after help command.
This function assumes that `standard-output' is the help buffer.
@@ -224,6 +224,7 @@ o SYMBOL Display the given function or variable's documentation and value.
p TOPIC Find packages matching a given topic keyword.
P PACKAGE Describe the given Emacs Lisp package.
r Display the Emacs manual in Info mode.
+R Prompt for a manual and then display it in Info mode.
s Display contents of current syntax table, plus explanations.
S SYMBOL Show the section for the given symbol in the Info manual
for the programming language used in this buffer.
@@ -365,7 +366,7 @@ With argument, display info only for the selected version."
(sort (delete-dups res) #'string>)))
(current (car all-versions)))
(setq version (completing-read
- (format "Read NEWS for the version (default %s): " current)
+ (format-prompt "Read NEWS for the version" current)
all-versions nil nil nil nil current))
(if (integerp (string-to-number version))
(setq version (string-to-number version))
@@ -459,6 +460,7 @@ the variable `message-log-max'."
"Display last few input keystrokes and the commands run.
For convenience this uses the same format as
`edit-last-kbd-macro'.
+See `lossage-size' to update the number of recorded keystrokes.
To record all your input, use `open-dribble-file'."
(interactive)
@@ -534,12 +536,9 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
(let ((fn (function-called-at-point))
(enable-recursive-minibuffers t)
val)
- (setq val (completing-read
- (if fn
- (format "Where is command (default %s): " fn)
- "Where is command: ")
- obarray 'commandp t nil nil
- (and fn (symbol-name fn))))
+ (setq val (completing-read (format-prompt "Where is command" fn)
+ obarray 'commandp t nil nil
+ (and fn (symbol-name fn))))
(list (unless (equal val "") (intern val))
current-prefix-arg)))
(unless definition (error "No command"))
@@ -879,114 +878,6 @@ current buffer."
(princ ", which is ")
(describe-function-1 defn)))))))
-(defun describe-mode (&optional buffer)
- "Display documentation of current major mode and minor modes.
-A brief summary of the minor modes comes first, followed by the
-major mode description. This is followed by detailed
-descriptions of the minor modes, each on a separate page.
-
-For this to work correctly for a minor mode, the mode's indicator
-variable \(listed in `minor-mode-alist') must also be a function
-whose documentation describes the minor mode.
-
-If called from Lisp with a non-nil BUFFER argument, display
-documentation for the major and minor modes of that buffer."
- (interactive "@")
- (unless buffer (setq buffer (current-buffer)))
- (help-setup-xref (list #'describe-mode buffer)
- (called-interactively-p 'interactive))
- ;; For the sake of help-do-xref and help-xref-go-back,
- ;; don't switch buffers before calling `help-buffer'.
- (with-help-window (help-buffer)
- (with-current-buffer buffer
- (let (minor-modes)
- ;; Older packages do not register in minor-mode-list but only in
- ;; minor-mode-alist.
- (dolist (x minor-mode-alist)
- (setq x (car x))
- (unless (memq x minor-mode-list)
- (push x minor-mode-list)))
- ;; Find enabled minor mode we will want to mention.
- (dolist (mode minor-mode-list)
- ;; Document a minor mode if it is listed in minor-mode-alist,
- ;; non-nil, and has a function definition.
- (let ((fmode (or (get mode :minor-mode-function) mode)))
- (and (boundp mode) (symbol-value mode)
- (fboundp fmode)
- (let ((pretty-minor-mode
- (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
- (symbol-name fmode))
- (capitalize
- (substring (symbol-name fmode)
- 0 (match-beginning 0)))
- fmode)))
- (push (list fmode pretty-minor-mode
- (format-mode-line (assq mode minor-mode-alist)))
- minor-modes)))))
- ;; Narrowing is not a minor mode, but its indicator is part of
- ;; mode-line-modes.
- (when (buffer-narrowed-p)
- (push '(narrow-to-region "Narrow" " Narrow") minor-modes))
- (setq minor-modes
- (sort minor-modes
- (lambda (a b) (string-lessp (cadr a) (cadr b)))))
- (when minor-modes
- (princ "Enabled minor modes:\n")
- (make-local-variable 'help-button-cache)
- (with-current-buffer standard-output
- (dolist (mode minor-modes)
- (let ((mode-function (nth 0 mode))
- (pretty-minor-mode (nth 1 mode))
- (indicator (nth 2 mode)))
- (save-excursion
- (goto-char (point-max))
- (princ "\n\f\n")
- (push (point-marker) help-button-cache)
- ;; Document the minor modes fully.
- (insert-text-button
- pretty-minor-mode 'type 'help-function
- 'help-args (list mode-function)
- 'button '(t))
- (princ (format " minor mode (%s):\n"
- (if (zerop (length indicator))
- "no indicator"
- (format "indicator%s"
- indicator))))
- (princ (help-split-fundoc (documentation mode-function)
- nil 'doc)))
- (insert-button pretty-minor-mode
- 'action (car help-button-cache)
- 'follow-link t
- 'help-echo "mouse-2, RET: show full information")
- (newline)))
- (forward-line -1)
- (fill-paragraph nil)
- (forward-line 1))
-
- (princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
- ;; Document the major mode.
- (let ((mode mode-name))
- (with-current-buffer standard-output
- (let ((start (point)))
- (insert (format-mode-line mode nil nil buffer))
- (add-text-properties start (point) '(face bold)))))
- (princ " mode")
- (let* ((mode major-mode)
- (file-name (find-lisp-object-file-name mode nil)))
- (when file-name
- (princ (format-message " defined in `%s'"
- (file-name-nondirectory file-name)))
- ;; Make a hyperlink to the library.
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
- nil t)
- (help-xref-button 1 'help-function-def mode file-name)))))
- (princ ":\n")
- (princ (help-split-fundoc (documentation major-mode) nil 'doc)))))
- ;; For the sake of IELM and maybe others
- nil)
-
(defun search-forward-help-for-help ()
"Search forward \"help window\"."
(interactive)
@@ -1082,6 +973,476 @@ is currently activated with completion."
minor-modes nil)
(setq minor-modes (cdr minor-modes)))))
result))
+
+
+(defun substitute-command-keys (string)
+ "Substitute key descriptions for command names in STRING.
+Each substring of the form \\\\=[COMMAND] is replaced by either a
+keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND
+is not on any keys.
+
+Each substring of the form \\\\={MAPVAR} is replaced by a summary of
+the value of MAPVAR as a keymap. This summary is similar to the one
+produced by ‘describe-bindings’. The summary ends in two newlines
+(used by the helper function ‘help-make-xrefs’ to find the end of the
+summary).
+
+Each substring of the form \\\\=<MAPVAR> specifies the use of MAPVAR
+as the keymap for future \\\\=[COMMAND] substrings.
+
+Each grave accent \\=` is replaced by left quote, and each apostrophe \\='
+is replaced by right quote. Left and right quote characters are
+specified by ‘text-quoting-style’.
+
+\\\\== quotes the following character and is discarded; thus, \\\\==\\\\== puts \\\\==
+into the output, \\\\==\\[ puts \\[ into the output, and \\\\==\\=` puts \\=` into the
+output.
+
+Return the original STRING if no substitutions are made.
+Otherwise, return a new string (without any text properties)."
+ (when (not (null string))
+ ;; KEYMAP is either nil (which means search all the active
+ ;; keymaps) or a specified local map (which means search just that
+ ;; and the global map). If non-nil, it might come from
+ ;; overriding-local-map, or from a \\<mapname> construct in STRING
+ ;; itself.
+ (let ((keymap overriding-local-map)
+ (inhibit-modification-hooks t)
+ (orig-buf (current-buffer)))
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (let ((orig-point (point))
+ end-point active-maps
+ close generate-summary)
+ (cond
+ ;; 1. Handle all sequences starting with "\"
+ ((= (following-char) ?\\)
+ (ignore-errors
+ (forward-char 1))
+ (cond
+ ;; 1A. Ignore \= at end of string.
+ ((and (= (+ (point) 1) (point-max))
+ (= (following-char) ?=))
+ (forward-char 1))
+ ;; 1B. \= quotes the next character; thus, to put in \[
+ ;; without its special meaning, use \=\[.
+ ((= (following-char) ?=)
+ (goto-char orig-point)
+ (delete-char 2)
+ (ignore-errors
+ (forward-char 1)))
+ ;; 1C. \[foo] is replaced with the keybinding.
+ ((and (= (following-char) ?\[)
+ (save-excursion
+ (prog1 (search-forward "]" nil t)
+ (setq end-point (- (point) 2)))))
+ (goto-char orig-point)
+ (delete-char 2)
+ (let* ((fun (intern (buffer-substring (point) (1- end-point))))
+ (key (with-current-buffer orig-buf
+ (where-is-internal fun keymap t))))
+ ;; If this a command remap, we need to follow it.
+ (when (and (vectorp key)
+ (> (length key) 1)
+ (eq (aref key 0) 'remap)
+ (symbolp (aref key 1)))
+ (setq fun (aref key 1))
+ (setq key (with-current-buffer orig-buf
+ (where-is-internal fun keymap t))))
+ (if (not key)
+ ;; Function is not on any key.
+ (progn (insert "M-x ")
+ (goto-char (+ end-point 3))
+ (delete-char 1))
+ ;; Function is on a key.
+ (delete-char (- end-point (point)))
+ (insert (key-description key)))))
+ ;; 1D. \{foo} is replaced with a summary of the keymap
+ ;; (symbol-value foo).
+ ;; \<foo> just sets the keymap used for \[cmd].
+ ((and (or (and (= (following-char) ?{)
+ (setq close "}")
+ (setq generate-summary t))
+ (and (= (following-char) ?<)
+ (setq close ">")))
+ (or (save-excursion
+ (prog1 (search-forward close nil t)
+ (setq end-point (- (point) 2))))))
+ (goto-char orig-point)
+ (delete-char 2)
+ (let* ((name (intern (buffer-substring (point) (1- end-point))))
+ this-keymap)
+ (delete-char (- end-point (point)))
+ ;; Get the value of the keymap in TEM, or nil if
+ ;; undefined. Do this in the user's current buffer
+ ;; in case it is a local variable.
+ (with-current-buffer orig-buf
+ ;; This is for computing the SHADOWS arg for
+ ;; describe-map-tree.
+ (setq active-maps (current-active-maps))
+ (when (boundp name)
+ (setq this-keymap (and (keymapp (symbol-value name))
+ (symbol-value name)))))
+ (cond
+ ((null this-keymap)
+ (insert "\nUses keymap "
+ (substitute-command-keys "`")
+ (symbol-name name)
+ (substitute-command-keys "'")
+ ", which is not currently defined.\n")
+ (unless generate-summary
+ (setq keymap nil)))
+ ((not generate-summary)
+ (setq keymap this-keymap))
+ (t
+ ;; Get the list of active keymaps that precede this one.
+ ;; If this one's not active, get nil.
+ (let ((earlier-maps (cdr (memq this-keymap (reverse active-maps)))))
+ (describe-map-tree this-keymap t (nreverse earlier-maps)
+ nil nil t nil nil t))))))))
+ ;; 2. Handle quotes.
+ ((and (eq (text-quoting-style) 'curve)
+ (or (and (= (following-char) ?\`)
+ (prog1 t (insert "‘")))
+ (and (= (following-char) ?')
+ (prog1 t (insert "’")))))
+ (delete-char 1))
+ ((and (eq (text-quoting-style) 'straight)
+ (= (following-char) ?\`))
+ (insert "'")
+ (delete-char 1))
+ ;; 3. Nothing to do -- next character.
+ (t (forward-char 1)))))
+ (buffer-string)))))
+
+(defvar help--keymaps-seen nil)
+(defun describe-map-tree (startmap partial shadow prefix title no-menu
+ transl always-title mention-shadow)
+ "Insert a description of the key bindings in STARTMAP.
+This is followed by the key bindings of all maps reachable
+through STARTMAP.
+
+If PARTIAL is non-nil, omit certain uninteresting commands
+\(such as `undefined').
+
+If SHADOW is non-nil, it is a list of maps; don't mention keys
+which would be shadowed by any of them.
+
+If PREFIX is non-nil, mention only keys that start with PREFIX.
+
+If TITLE is non-nil, is a string to insert at the beginning.
+TITLE should not end with a colon or a newline; we supply that.
+
+If NOMENU is non-nil, then omit menu-bar commands.
+
+If TRANSL is non-nil, the definitions are actually key
+translations so print strings and vectors differently.
+
+If ALWAYS_TITLE is non-nil, print the title even if there are no
+maps to look through.
+
+If MENTION_SHADOW is non-nil, then when something is shadowed by
+SHADOW, don't omit it; instead, mention it but say it is
+shadowed.
+
+Any inserted text ends in two newlines (used by
+`help-make-xrefs')."
+ (let* ((amaps (accessible-keymaps startmap prefix))
+ (orig-maps (if no-menu
+ (progn
+ ;; Delete from MAPS each element that is for
+ ;; the menu bar.
+ (let* ((tail amaps)
+ result)
+ (while tail
+ (let ((elem (car tail)))
+ (when (not (and (>= (length (car elem)) 1)
+ (eq (elt (car elem) 0) 'menu-bar)))
+ (setq result (append result (list elem)))))
+ (setq tail (cdr tail)))
+ result))
+ amaps))
+ (maps orig-maps)
+ (print-title (or maps always-title)))
+ ;; Print title.
+ (when print-title
+ (insert (concat (if title
+ (concat title
+ (if prefix
+ (concat " Starting With "
+ (key-description prefix)))
+ ":\n"))
+ "key binding\n"
+ "--- -------\n")))
+ ;; Describe key bindings.
+ (setq help--keymaps-seen nil)
+ (while (consp maps)
+ (let* ((elt (car maps))
+ (elt-prefix (car elt))
+ (sub-shadows (lookup-key shadow elt-prefix t)))
+ (when (if (natnump sub-shadows)
+ (prog1 t (setq sub-shadows nil))
+ ;; Describe this map iff elt_prefix is bound to a
+ ;; keymap, since otherwise it completely shadows this
+ ;; map.
+ (or (keymapp sub-shadows)
+ (null sub-shadows)
+ (and (consp sub-shadows)
+ (keymapp (car sub-shadows)))))
+ ;; Maps we have already listed in this loop shadow this map.
+ (let ((tail orig-maps))
+ (while (not (equal tail maps))
+ (when (equal (car (car tail)) elt-prefix)
+ (setq sub-shadows (cons (cdr (car tail)) sub-shadows)))
+ (setq tail (cdr tail))))
+ (describe-map (cdr elt) elt-prefix transl partial
+ sub-shadows no-menu mention-shadow)))
+ (setq maps (cdr maps)))
+ (when print-title
+ (insert "\n"))))
+
+(defun help--shadow-lookup (keymap key accept-default remap)
+ "Like `lookup-key', but with command remapping.
+Return nil if the key sequence is too long."
+ ;; Converted from shadow_lookup in keymap.c.
+ (let ((value (lookup-key keymap key accept-default)))
+ (cond ((and (fixnump value) (<= 0 value)))
+ ((and value remap (symbolp value))
+ (or (command-remapping value nil keymap)
+ value))
+ (t value))))
+
+(defvar help--previous-description-column 0)
+(defun help--describe-command (definition)
+ ;; Converted from describe_command in keymap.c.
+ ;; If column 16 is no good, go to col 32;
+ ;; but don't push beyond that--go to next line instead.
+ (let* ((column (current-column))
+ (description-column (cond ((> column 30)
+ (insert "\n")
+ 32)
+ ((or (> column 14)
+ (and (> column 10)
+ (= help--previous-description-column 32)))
+ 32)
+ (t 16))))
+ (indent-to description-column 1)
+ (setq help--previous-description-column description-column)
+ (cond ((symbolp definition)
+ (insert (symbol-name definition) "\n"))
+ ((or (stringp definition) (vectorp definition))
+ (insert "Keyboard Macro\n"))
+ ((keymapp definition)
+ (insert "Prefix Command\n"))
+ (t (insert "??\n")))))
+
+(defun help--describe-translation (definition)
+ ;; Converted from describe_translation in keymap.c.
+ (indent-to 16 1)
+ (cond ((symbolp definition)
+ (insert (symbol-name definition) "\n"))
+ ((or (stringp definition) (vectorp definition))
+ (insert (key-description definition nil) "\n"))
+ ((keymapp definition)
+ (insert "Prefix Command\n"))
+ (t (insert "??\n"))))
+
+(defun help--describe-map-compare (a b)
+ (let ((a (car a))
+ (b (car b)))
+ (cond ((and (fixnump a) (fixnump b)) (< a b))
+ ;; ((and (not (fixnump a)) (fixnump b)) nil) ; not needed
+ ((and (fixnump a) (not (fixnump b))) t)
+ ((and (symbolp a) (symbolp b))
+ ;; Sort the keystroke names in the "natural" way, with (for
+ ;; instance) "<f2>" coming between "<f1>" and "<f11>".
+ (string-version-lessp (symbol-name a) (symbol-name b)))
+ (t nil))))
+
+(defun describe-map (map prefix transl partial shadow nomenu mention-shadow)
+ "Describe the contents of keymap MAP.
+Assume that this keymap itself is reached by the sequence of
+prefix keys PREFIX (a string or vector).
+
+TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
+`describe-map-tree'."
+ ;; Converted from describe_map in keymap.c.
+ (let* ((suppress (and partial 'suppress-keymap))
+ (map (keymap-canonicalize map))
+ (tail map)
+ (first t)
+ (describer (if transl
+ #'help--describe-translation
+ #'help--describe-command))
+ done vect)
+ (while (and (consp tail) (not done))
+ (cond ((or (vectorp (car tail)) (char-table-p (car tail)))
+ (help--describe-vector (car tail) prefix describer partial
+ shadow map mention-shadow))
+ ((consp (car tail))
+ (let ((event (caar tail))
+ definition this-shadowed)
+ ;; Ignore bindings whose "prefix" are not really
+ ;; valid events. (We get these in the frames and
+ ;; buffers menu.)
+ (and (or (symbolp event) (fixnump event))
+ (not (and nomenu (eq event 'menu-bar)))
+ ;; Don't show undefined commands or suppressed
+ ;; commands.
+ (setq definition (keymap--get-keyelt (cdr (car tail)) nil))
+ (or (not (symbolp definition))
+ (null (get definition suppress)))
+ ;; Don't show a command that isn't really
+ ;; visible because a local definition of the
+ ;; same key shadows it.
+ (or (not shadow)
+ (let ((tem (help--shadow-lookup shadow (vector event) t nil)))
+ (cond ((null tem) t)
+ ;; If both bindings are keymaps,
+ ;; this key is a prefix key, so
+ ;; don't say it is shadowed.
+ ((and (keymapp definition) (keymapp tem)) t)
+ ;; Avoid generating duplicate
+ ;; entries if the shadowed binding
+ ;; has the same definition.
+ ((and mention-shadow (not (eq tem definition)))
+ (setq this-shadowed t))
+ (t nil))))
+ (eq definition (lookup-key tail (vector event) t))
+ (push (list event definition this-shadowed) vect))))
+ ((eq (car tail) 'keymap)
+ ;; The same keymap might be in the structure twice, if
+ ;; we're using an inherited keymap. So skip anything
+ ;; we've already encountered.
+ (let ((tem (assq tail help--keymaps-seen)))
+ (if (and (consp tem)
+ (equal (car tem) prefix))
+ (setq done t)
+ (push (cons tail prefix) help--keymaps-seen)))))
+ (setq tail (cdr tail)))
+ ;; If we found some sparse map events, sort them.
+ (let ((vect (sort vect 'help--describe-map-compare)))
+ ;; Now output them in sorted order.
+ (while vect
+ (let* ((elem (car vect))
+ (start (car elem))
+ (definition (cadr elem))
+ (shadowed (caddr elem))
+ (end start))
+ (when first
+ (setq help--previous-description-column 0)
+ (insert "\n")
+ (setq first nil))
+ ;; Find consecutive chars that are identically defined.
+ (when (fixnump start)
+ (while (and (cdr vect)
+ (let ((this-event (caar vect))
+ (this-definition (cadar vect))
+ (this-shadowed (caddar vect))
+ (next-event (caar (cdr vect)))
+ (next-definition (cadar (cdr vect)))
+ (next-shadowed (caddar (cdr vect))))
+ (and (eq next-event (1+ this-event))
+ (equal next-definition this-definition)
+ (eq this-shadowed next-shadowed))))
+ (setq vect (cdr vect))
+ (setq end (caar vect))))
+ ;; Now START .. END is the range to describe next.
+ ;; Insert the string to describe the event START.
+ (insert (key-description (vector start) prefix))
+ (when (not (eq start end))
+ (insert " .. " (key-description (vector end) prefix)))
+ ;; Print a description of the definition of this character.
+ ;; Called function will take care of spacing out far enough
+ ;; for alignment purposes.
+ (if transl
+ (help--describe-translation definition)
+ (help--describe-command definition))
+ ;; Print a description of the definition of this character.
+ ;; elt_describer will take care of spacing out far enough for
+ ;; alignment purposes.
+ (when shadowed
+ (goto-char (max (1- (point)) (point-min)))
+ (insert "\n (this binding is currently shadowed)")
+ (goto-char (min (1+ (point)) (point-max)))))
+ ;; Next item in list.
+ (setq vect (cdr vect))))))
+
+;;;; This Lisp version is 100 times slower than its C equivalent:
+;;
+;; (defun help--describe-vector
+;; (vector prefix transl partial shadow entire-map mention-shadow)
+;; "Insert in the current buffer a description of the contents of VECTOR.
+;;
+;; PREFIX a prefix key which leads to the keymap that this vector is
+;; in.
+;;
+;; If PARTIAL, it means do not mention suppressed commands
+;; (that assumes the vector is in a keymap).
+;;
+;; SHADOW is a list of keymaps that shadow this map. If it is
+;; non-nil, look up the key in those maps and don't mention it if it
+;; is defined by any of them.
+;;
+;; ENTIRE-MAP is the vector in which this vector appears.
+;; If the definition in effect in the whole map does not match
+;; the one in this vector, we ignore this one."
+;; ;; Converted from describe_vector in keymap.c.
+;; (let* ((first t)
+;; (idx 0))
+;; (while (< idx (length vector))
+;; (let* ((val (aref vector idx))
+;; (definition (keymap--get-keyelt val nil))
+;; (start-idx idx)
+;; this-shadowed
+;; found-range)
+;; (when (and definition
+;; ;; Don't mention suppressed commands.
+;; (not (and partial
+;; (symbolp definition)
+;; (get definition 'suppress-keymap)))
+;; ;; If this binding is shadowed by some other map,
+;; ;; ignore it.
+;; (not (and shadow
+;; (help--shadow-lookup shadow (vector start-idx) t nil)
+;; (if mention-shadow
+;; (prog1 nil (setq this-shadowed t))
+;; t)))
+;; ;; Ignore this definition if it is shadowed by an earlier
+;; ;; one in the same keymap.
+;; (not (and entire-map
+;; (not (eq (lookup-key entire-map (vector start-idx) t)
+;; definition)))))
+;; (when first
+;; (insert "\n")
+;; (setq first nil))
+;; (when (and prefix (> (length prefix) 0))
+;; (insert (format "%s" prefix)))
+;; (insert (key-description (vector start-idx) prefix))
+;; ;; Find all consecutive characters or rows that have the
+;; ;; same definition.
+;; (while (equal (keymap--get-keyelt (aref vector (1+ idx)) nil)
+;; definition)
+;; (setq found-range t)
+;; (setq idx (1+ idx)))
+;; ;; If we have a range of more than one character,
+;; ;; print where the range reaches to.
+;; (when found-range
+;; (insert " .. ")
+;; (when (and prefix (> (length prefix) 0))
+;; (insert (format "%s" prefix)))
+;; (insert (key-description (vector idx) prefix)))
+;; (if transl
+;; (help--describe-translation definition)
+;; (help--describe-command definition))
+;; (when this-shadowed
+;; (goto-char (1- (point)))
+;; (insert " (binding currently shadowed)")
+;; (goto-char (1+ (point))))))
+;; (setq idx (1+ idx)))))
+
(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
(declare-function x-display-pixel-width "xfns.c" (&optional terminal))
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 2535d581db4..5d813c410c2 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -93,7 +93,15 @@ as that will override any bit grouping options set here."
"Face used in address area of Hexl mode buffer.")
(defface hexl-ascii-region
- '((t (:inherit header-line)))
+ ;; Copied from `header-line`. We used to inherit from it, but that
+ ;; looks awful when the headerline is given a variable-pitch font or
+ ;; (even worse) a 3D look.
+ '((((class color grayscale) (background light))
+ :background "grey90" :foreground "grey20"
+ :box nil)
+ (((class color grayscale) (background dark))
+ :background "grey20" :foreground "grey90"
+ :box nil))
"Face used in ASCII area of Hexl mode buffer.")
(defvar-local hexl-max-address 0
@@ -209,10 +217,14 @@ as that will override any bit grouping options set here."
(make-variable-buffer-local 'hexl-ascii-overlay)
(defvar hexl-font-lock-keywords
- '(("^\\([0-9a-f]+:\\).\\{40\\} \\(.+$\\)"
- ;; "^\\([0-9a-f]+:\\).+ \\(.+$\\)"
+ '(("^\\([0-9a-f]+:\\)\\( \\).\\{39\\}\\( \\)\\(.+$\\)"
+ ;; "^\\([0-9a-f]+:\\).+ \\(.+$\\)"v
(1 'hexl-address-region t t)
- (2 'hexl-ascii-region t t)))
+ ;; If `hexl-address-region' is using a variable-pitch font, the
+ ;; rest of the line isn't naturally aligned, so align them by hand.
+ (2 '(face nil display (space :align-to 10)))
+ (3 '(face nil display (space :align-to 51)))
+ (4 'hexl-ascii-region t t)))
"Font lock keywords used in `hexl-mode'.")
(defun hexl-rulerize (string bits)
@@ -362,13 +374,14 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
(setq-local font-lock-defaults '(hexl-font-lock-keywords t))
+ (setq-local font-lock-extra-managed-props '(display))
(setq-local revert-buffer-function #'hexl-revert-buffer-function)
(add-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer nil t)
;; Set a callback function for eldoc.
- (add-function :before-until (local 'eldoc-documentation-function)
- #'hexl-print-current-point-info)
+ (add-hook 'eldoc-documentation-functions
+ #'hexl-print-current-point-info nil t)
(eldoc-add-command-completions "hexl-")
(eldoc-remove-command "hexl-save-buffer"
"hexl-current-address")
@@ -455,6 +468,8 @@ and edit the file in `hexl-mode'."
;; 2. reset change-major-mode-hook in case that `hexl-mode'
;; previously added hexl-maybe-dehexlify-buffer to it.
(remove-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer t)
+ (remove-hook 'eldoc-documentation-functions
+ #'hexl-print-current-point-info t)
(setq major-mode 'fundamental-mode)
(hexl-mode)))
@@ -513,7 +528,7 @@ Ask the user for confirmation."
(message "Current address is %d/0x%08x" hexl-address hexl-address))
hexl-address))
-(defun hexl-print-current-point-info ()
+(defun hexl-print-current-point-info (&rest _ignored)
"Return current hexl-address in string.
This function is intended to be used as eldoc callback."
(let ((addr (hexl-current-address)))
@@ -701,10 +716,7 @@ With prefix arg N, puts point N bytes of the way from the true beginning."
(defun hexl-end-of-line ()
"Goto end of line in Hexl mode."
(interactive)
- (hexl-goto-address (let ((address (logior (hexl-current-address) 15)))
- (if (> address hexl-max-address)
- (setq address hexl-max-address))
- address)))
+ (hexl-goto-address (min hexl-max-address (logior (hexl-current-address) 15))))
(defun hexl-scroll-down (arg)
"Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
@@ -749,7 +761,7 @@ If there's no byte at the target address, move to the first or last line."
"Go to end of 1KB boundary."
(interactive)
(hexl-goto-address
- (max hexl-max-address (logior (hexl-current-address) 1023))))
+ (min hexl-max-address (logior (hexl-current-address) 1023))))
(defun hexl-beginning-of-512b-page ()
"Go to beginning of 512 byte boundary."
@@ -760,7 +772,7 @@ If there's no byte at the target address, move to the first or last line."
"Go to end of 512 byte boundary."
(interactive)
(hexl-goto-address
- (max hexl-max-address (logior (hexl-current-address) 511))))
+ (min hexl-max-address (logior (hexl-current-address) 511))))
(defun hexl-quoted-insert (arg)
"Read next input character and insert it.
@@ -887,7 +899,7 @@ and their encoded form is inserted byte by byte."
(when (null encoded)
(setq internal (encode-coding-string internal 'utf-8-emacs)
internal-hex
- (mapconcat (function (lambda (c) (format "%x" c)))
+ (mapconcat (lambda (c) (format "%x" c))
internal " "))
(if (yes-or-no-p
(format-message
@@ -900,7 +912,7 @@ and their encoded form is inserted byte by byte."
(substitute-command-keys "try \\[hexl-insert-hex-string]"))))
(while (> num 0)
(mapc
- (function (lambda (c) (hexl-insert-char c 1))) encoded)
+ (lambda (c) (hexl-insert-char c 1)) encoded)
(setq num (1- num))))))))
(defun hexl-self-insert-command (arg)
@@ -935,7 +947,7 @@ CH must be a unibyte character whose value is between 0 and 255."
(goto-char ascii-position)
(delete-char 1)
(insert (hexl-printable-character ch))
- (or (eq address hexl-max-address)
+ (or (= address hexl-max-address)
(setq address (1+ address)))
(hexl-goto-address address)
(if at-ascii-position
diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el
index 4cff2a42001..a3398f6e809 100644
--- a/lisp/hfy-cmap.el
+++ b/lisp/hfy-cmap.el
@@ -1,4 +1,4 @@
-;;; hfy-cmap.el --- Fallback color name -> rgb mapping for `htmlfontify'
+;;; hfy-cmap.el --- Fallback color name -> rgb mapping for `htmlfontify' -*- lexical-binding:t -*-
;; Copyright (C) 2002-2003, 2009-2020 Free Software Foundation, Inc.
@@ -809,6 +809,22 @@
(defconst hfy-rgb-regex
"^\\s-*\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\(.+\\)\\s-*$")
+(defun hfy-cmap--parse-buffer (buffer)
+ (with-current-buffer buffer
+ (let ((end-of-rgb 0)
+ result)
+ (goto-char (point-min))
+ (htmlfontify-unload-rgb-file)
+ (while (/= end-of-rgb 1)
+ (if (looking-at hfy-rgb-regex)
+ (push (list (match-string 4)
+ (string-to-number (match-string 1))
+ (string-to-number (match-string 2))
+ (string-to-number (match-string 3)))
+ result))
+ (setq end-of-rgb (forward-line)))
+ result)))
+
;;;###autoload
(defun htmlfontify-load-rgb-file (&optional file)
"Load an X11 style rgb.txt FILE.
@@ -818,25 +834,14 @@ Loads the variable `hfy-rgb-txt-color-map', which is used by
(interactive
(list
(read-file-name "rgb.txt (equivalent) file: " "" nil t (hfy-rgb-file))))
- (let ((rgb-buffer nil)
- (end-of-rgb 0)
- (rgb-txt nil))
- (if (and (setq rgb-txt (or file (hfy-rgb-file)))
- (file-readable-p rgb-txt))
- (with-current-buffer
- (setq rgb-buffer (find-file-noselect rgb-txt 'nowarn))
- (goto-char (point-min))
- (htmlfontify-unload-rgb-file)
- (while (/= end-of-rgb 1)
- (if (looking-at hfy-rgb-regex)
- (setq hfy-rgb-txt-color-map
- (cons (list (match-string 4)
- (string-to-number (match-string 1))
- (string-to-number (match-string 2))
- (string-to-number (match-string 3)))
- hfy-rgb-txt-color-map)) )
- (setq end-of-rgb (forward-line)))
- (kill-buffer rgb-buffer)))))
+ (let ((rgb-buffer nil)
+ (rgb-txt (or file (hfy-rgb-file))))
+ (when (and rgb-txt
+ (file-readable-p rgb-txt))
+ (setq rgb-buffer (find-file-noselect rgb-txt 'nowarn))
+ (when-let ((result (hfy-cmap--parse-buffer rgb-buffer)))
+ (setq hfy-rgb-txt-color-map result))
+ (kill-buffer rgb-buffer))))
(defun htmlfontify-unload-rgb-file ()
"Unload the current color name -> rgb translation map."
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 3e7a960bf23..536a1af8462 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -102,7 +102,7 @@ of functions `hi-lock-mode' and `hi-lock-find-patterns'."
:type 'integer
:group 'hi-lock)
-(defcustom hi-lock-highlight-range 200000
+(defcustom hi-lock-highlight-range 2000000
"Size of area highlighted by hi-lock when font-lock not active.
Font-lock is not active in buffers that do their own highlighting,
such as the buffer created by `list-colors-display'. In those buffers
@@ -233,17 +233,15 @@ by cycling through the faces in `hi-lock-face-defaults'."
"Patterns provided to hi-lock by user. Should not be changed.")
(put 'hi-lock-interactive-patterns 'permanent-local t)
-(define-obsolete-variable-alias 'hi-lock-face-history
- 'hi-lock-face-defaults "23.1")
+(defvar-local hi-lock-interactive-lighters nil
+ "Human-readable lighters for `hi-lock-interactive-patterns'.")
+(put 'hi-lock-interactive-lighters 'permanent-local t)
+
(defvar hi-lock-face-defaults
'("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-salmon" "hi-aquamarine"
"hi-black-b" "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb")
"Default faces for hi-lock interactive functions.")
-(define-obsolete-variable-alias 'hi-lock-regexp-history
- 'regexp-history
- "23.1")
-
(defvar hi-lock-file-patterns-prefix "Hi-lock"
"String used to identify hi-lock patterns at the start of files.")
@@ -406,7 +404,8 @@ versions before 22 use the following in your init file:
hi-lock-file-patterns)
(when hi-lock-interactive-patterns
(font-lock-remove-keywords nil hi-lock-interactive-patterns)
- (setq hi-lock-interactive-patterns nil))
+ (setq hi-lock-interactive-patterns nil
+ hi-lock-interactive-lighters nil))
(when hi-lock-file-patterns
(font-lock-remove-keywords nil hi-lock-file-patterns)
(setq hi-lock-file-patterns nil))
@@ -437,6 +436,9 @@ of text in those lines.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type."
@@ -450,19 +452,29 @@ highlighting will not update as you type."
(hi-lock-set-pattern
;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
;; or a trailing $ in REGEXP will be interpreted correctly.
- (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face))
+ (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face nil nil
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)))
;;;###autoload
(defalias 'highlight-regexp 'hi-lock-face-buffer)
;;;###autoload
-(defun hi-lock-face-buffer (regexp &optional face subexp)
+(defun hi-lock-face-buffer (regexp &optional face subexp lighter)
"Set face of each match of REGEXP to FACE.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE. Limit face setting to the
corresponding SUBEXP (interactively, the prefix argument) of REGEXP.
If SUBEXP is omitted or nil, the entire REGEXP is highlighted.
+LIGHTER is a human-readable string that can be used to select
+a regexp to unhighlight by its name instead of selecting a possibly
+complex regexp or closure.
+
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type. The Font Lock mode
@@ -472,12 +484,25 @@ the major mode specifies support for Font Lock."
(interactive
(list
(hi-lock-regexp-okay
- (read-regexp "Regexp to highlight" 'regexp-history-last))
+ (read-regexp "Regexp to highlight"
+ (if (use-region-p)
+ (prog1
+ (buffer-substring (region-beginning)
+ (region-end))
+ (deactivate-mark))
+ 'regexp-history-last)))
(hi-lock-read-face-name)
current-prefix-arg))
+ (when (stringp face)
+ (setq face (intern face)))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
- (hi-lock-set-pattern regexp face subexp))
+ (hi-lock-set-pattern
+ regexp face subexp lighter
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)
+ search-spaces-regexp))
;;;###autoload
(defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
@@ -487,9 +512,9 @@ the major mode specifies support for Font Lock."
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
-When called interactively, replace whitespace in user-provided
-regexp with arbitrary whitespace, and make initial lower-case
-letters case-insensitive, before highlighting with `hi-lock-set-pattern'.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+Also set `search-spaces-regexp' to the value of `search-whitespace-regexp'.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@@ -500,12 +525,16 @@ the major mode specifies support for Font Lock."
(interactive
(list
(hi-lock-regexp-okay
- (hi-lock-process-phrase
- (read-regexp "Phrase to highlight" 'regexp-history-last)))
+ (read-regexp "Phrase to highlight" 'regexp-history-last))
(hi-lock-read-face-name)))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
- (hi-lock-set-pattern regexp face))
+ (hi-lock-set-pattern
+ regexp face nil nil
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)
+ search-whitespace-regexp))
;;;###autoload
(defalias 'highlight-symbol-at-point 'hi-lock-face-symbol-at-point)
@@ -516,6 +545,9 @@ Uses the next face from `hi-lock-face-defaults' without prompting,
unless you use a prefix argument.
Uses `find-tag-default-as-symbol-regexp' to retrieve the symbol at point.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
This uses Font lock mode if it is enabled; otherwise it uses overlays,
in which case the highlighting will not update as you type. The Font
Lock mode is considered \"enabled\" in a buffer if its `major-mode'
@@ -528,7 +560,11 @@ the major mode specifies support for Font Lock."
(face (hi-lock-read-face-name)))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
- (hi-lock-set-pattern regexp face)))
+ (hi-lock-set-pattern
+ regexp face nil nil
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search))))
(defun hi-lock-keyword->face (keyword)
(cadr (cadr (cadr keyword)))) ; Keyword looks like (REGEXP (0 'FACE) ...).
@@ -542,13 +578,16 @@ the major mode specifies support for Font Lock."
(let ((regexp (get-char-property (point) 'hi-lock-overlay-regexp)))
(when regexp (push regexp regexps)))
;; With font-locking on, check if the cursor is on a highlighted text.
- (let ((face-after (get-text-property (point) 'face))
- (face-before
- (unless (bobp) (get-text-property (1- (point)) 'face)))
- (faces (mapcar #'hi-lock-keyword->face
- hi-lock-interactive-patterns)))
- (unless (memq face-before faces) (setq face-before nil))
- (unless (memq face-after faces) (setq face-after nil))
+ (let* ((faces-after (get-text-property (point) 'face))
+ (faces-before
+ (unless (bobp) (get-text-property (1- (point)) 'face)))
+ ;; Use proper-list-p to handle faces like (foreground-color . "red3")
+ (faces-after (if (proper-list-p faces-after) faces-after (list faces-after)))
+ (faces-before (if (proper-list-p faces-before) faces-before (list faces-before)))
+ (faces (mapcar #'hi-lock-keyword->face
+ hi-lock-interactive-patterns))
+ (face-after (seq-some (lambda (face) (car (memq face faces))) faces-after))
+ (face-before (seq-some (lambda (face) (car (memq face faces))) faces-before)))
(when (and face-before face-after (not (eq face-before face-after)))
(setq face-before nil))
(when (or face-after face-before)
@@ -566,7 +605,8 @@ the major mode specifies support for Font Lock."
;; highlighted text at point. Use this later in
;; during completing-read.
(dolist (hi-lock-pattern hi-lock-interactive-patterns)
- (let ((regexp (car hi-lock-pattern)))
+ (let ((regexp (or (car (rassq hi-lock-pattern hi-lock-interactive-lighters))
+ (car hi-lock-pattern))))
(if (string-match regexp hi-text)
(push regexp regexps)))))))
regexps))
@@ -598,12 +638,15 @@ then remove all hi-lock highlighting."
'keymap
(cons "Select Pattern to Unhighlight"
(mapcar (lambda (pattern)
- (list (car pattern)
- (format
- "%s (%s)" (car pattern)
- (hi-lock-keyword->face pattern))
- (cons nil nil)
- (car pattern)))
+ (let ((lighter
+ (or (car (rassq pattern hi-lock-interactive-lighters))
+ (car pattern))))
+ (list lighter
+ (format
+ "%s (%s)" lighter
+ (hi-lock-keyword->face pattern))
+ (cons nil nil)
+ lighter)))
hi-lock-interactive-patterns))))
;; If the user clicks outside the menu, meaning that they
;; change their mind, x-popup-menu returns nil, and
@@ -614,17 +657,25 @@ then remove all hi-lock highlighting."
(t
;; Un-highlighting triggered via keyboard action.
(unless hi-lock-interactive-patterns
- (error "No highlighting to remove"))
+ (user-error "No highlighting to remove"))
;; Infer the regexp to un-highlight based on cursor position.
(let* ((defaults (or (hi-lock--regexps-at-point)
- (mapcar #'car hi-lock-interactive-patterns))))
+ (mapcar (lambda (pattern)
+ (or (car (rassq pattern hi-lock-interactive-lighters))
+ (car pattern)))
+ hi-lock-interactive-patterns))))
(list
- (completing-read (if (null defaults)
- "Regexp to unhighlight: "
- (format "Regexp to unhighlight (default %s): "
- (car defaults)))
- hi-lock-interactive-patterns
+ (completing-read (format-prompt "Regexp to unhighlight" (car defaults))
+ (mapcar (lambda (pattern)
+ (cons (or (car (rassq pattern hi-lock-interactive-lighters))
+ (car pattern))
+ (cdr pattern)))
+ hi-lock-interactive-patterns)
nil t nil nil defaults))))))
+
+ (when (assoc regexp hi-lock-interactive-lighters)
+ (setq regexp (cadr (assoc regexp hi-lock-interactive-lighters))))
+
(dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns
(list (assoc regexp hi-lock-interactive-patterns))))
(when keyword
@@ -641,7 +692,11 @@ then remove all hi-lock highlighting."
(setq hi-lock-interactive-patterns
(delq keyword hi-lock-interactive-patterns))
(remove-overlays
- nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword)))
+ nil nil 'hi-lock-overlay-regexp
+ (or (car (rassq keyword hi-lock-interactive-lighters))
+ (hi-lock--hashcons (car keyword))))
+ (setq hi-lock-interactive-lighters
+ (rassq-delete-all keyword hi-lock-interactive-lighters))
(font-lock-flush))))
;;;###autoload
@@ -653,7 +708,7 @@ Interactively added patterns are those normally specified using
be found in variable `hi-lock-interactive-patterns'."
(interactive)
(if (null hi-lock-interactive-patterns)
- (error "There are no interactive patterns"))
+ (user-error "There are no interactive patterns"))
(let ((beg (point)))
(mapc
(lambda (pattern)
@@ -667,25 +722,6 @@ be found in variable `hi-lock-interactive-patterns'."
;; Implementation Functions
-(defun hi-lock-process-phrase (phrase)
- "Convert regexp PHRASE to a regexp that matches phrases.
-
-Blanks in PHRASE replaced by regexp that matches arbitrary whitespace
-and initial lower-case letters made case insensitive."
- (let ((mod-phrase nil))
- ;; FIXME fragile; better to just bind case-fold-search? (Bug#7161)
- (setq mod-phrase
- (replace-regexp-in-string
- "\\(^\\|\\s-\\)\\([a-z]\\)"
- (lambda (m) (format "%s[%s%s]"
- (match-string 1 m)
- (upcase (match-string 2 m))
- (match-string 2 m))) phrase))
- ;; FIXME fragile; better to use search-spaces-regexp?
- (setq mod-phrase
- (replace-regexp-in-string
- "\\s-+" "[ \t\n]+" mod-phrase nil t))))
-
(defun hi-lock-regexp-okay (regexp)
"Return REGEXP if it appears suitable for a font-lock pattern.
@@ -716,8 +752,7 @@ with completion and history."
(if (and hi-lock-auto-select-face (not current-prefix-arg))
(setq face (or (pop hi-lock--unused-faces) (car defaults)))
(setq face (completing-read
- (format "Highlight using face (default %s): "
- (car defaults))
+ (format-prompt "Highlight using face" (car defaults))
obarray 'facep t nil 'face-name-history defaults))
;; Update list of un-used faces.
(setq hi-lock--unused-faces (remove face hi-lock--unused-faces))
@@ -725,19 +760,27 @@ with completion and history."
(add-to-list 'hi-lock-face-defaults face t))
(intern face)))
-(defun hi-lock-set-pattern (regexp face &optional subexp)
+(defun hi-lock-set-pattern (regexp face &optional subexp lighter case-fold spaces-regexp)
"Highlight SUBEXP of REGEXP with face FACE.
If omitted or nil, SUBEXP defaults to zero, i.e. the entire
-REGEXP is highlighted."
+REGEXP is highlighted. LIGHTER is a human-readable string to
+display instead of a regexp. Non-nil CASE-FOLD ignores case.
+SPACES-REGEXP is a regexp to substitute spaces in font-lock search."
;; Hashcons the regexp, so it can be passed to remove-overlays later.
(setq regexp (hi-lock--hashcons regexp))
(setq subexp (or subexp 0))
- (let ((pattern (list regexp (list subexp (list 'quote face) 'prepend)))
+ (let ((pattern (list (lambda (limit)
+ (let ((case-fold-search case-fold)
+ (search-spaces-regexp spaces-regexp))
+ (re-search-forward regexp limit t)))
+ (list subexp (list 'quote face) 'prepend)))
(no-matches t))
;; Refuse to highlight a text that is already highlighted.
- (if (assoc regexp hi-lock-interactive-patterns)
+ (if (or (assoc regexp hi-lock-interactive-patterns)
+ (assoc (or lighter regexp) hi-lock-interactive-lighters))
(add-to-list 'hi-lock--unused-faces (face-name face))
(push pattern hi-lock-interactive-patterns)
+ (push (cons (or lighter regexp) pattern) hi-lock-interactive-lighters)
(if (and font-lock-mode (font-lock-specified-p major-mode))
(progn
(font-lock-add-keywords nil (list pattern) t)
@@ -749,7 +792,9 @@ REGEXP is highlighted."
(- range-min (max 0 (- range-max (point-max))))))
(search-end
(min (point-max)
- (+ range-max (max 0 (- (point-min) range-min))))))
+ (+ range-max (max 0 (- (point-min) range-min)))))
+ (case-fold-search case-fold)
+ (search-spaces-regexp spaces-regexp))
(save-excursion
(goto-char search-start)
(while (re-search-forward regexp search-end t)
@@ -757,13 +802,17 @@ REGEXP is highlighted."
(let ((overlay (make-overlay (match-beginning subexp)
(match-end subexp))))
(overlay-put overlay 'hi-lock-overlay t)
- (overlay-put overlay 'hi-lock-overlay-regexp regexp)
+ (overlay-put overlay 'hi-lock-overlay-regexp (or lighter regexp))
(overlay-put overlay 'face face))
(goto-char (match-end 0)))
(when no-matches
(add-to-list 'hi-lock--unused-faces (face-name face))
(setq hi-lock-interactive-patterns
- (cdr hi-lock-interactive-patterns)))))))))
+ (cdr hi-lock-interactive-patterns)
+ hi-lock-interactive-lighters
+ (cdr hi-lock-interactive-lighters))))
+ (when (or (> search-start (point-min)) (< search-end (point-max)))
+ (message "Hi-lock added only in range %d-%d" search-start search-end)))))))
(defun hi-lock-set-file-patterns (patterns)
"Replace file patterns list with PATTERNS and refontify."
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 04a5ccd8d59..ae97bb008af 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -224,9 +224,6 @@ colors then use this, if you want fancier faces then set
;; When you invoke highlight-changes-mode, should highlight-changes-visible-mode
;; be on or off?
-(define-obsolete-variable-alias 'highlight-changes-initial-state
- 'highlight-changes-visibility-initial-state "23.1")
-
(defcustom highlight-changes-visibility-initial-state t
"Controls whether changes are initially visible in Highlight Changes mode.
@@ -236,13 +233,7 @@ When a buffer is in Highlight Changes mode the function
:type 'boolean
:group 'highlight-changes)
-;; highlight-changes-global-initial-state has been removed
-
-
-
;; These are the strings displayed in the mode-line for the minor mode:
-(define-obsolete-variable-alias 'highlight-changes-active-string
- 'highlight-changes-visible-string "23.1")
(defcustom highlight-changes-visible-string " +Chg"
"The string used when in Highlight Changes mode and changes are visible.
@@ -252,9 +243,6 @@ a string with a leading space."
(const :tag "None" nil))
:group 'highlight-changes)
-(define-obsolete-variable-alias 'highlight-changes-passive-string
- 'highlight-changes-invisible-string "23.1")
-
(defcustom highlight-changes-invisible-string " -Chg"
"The string used when in Highlight Changes mode and changes are hidden.
This should be set to nil if no indication is desired, or to
@@ -957,10 +945,6 @@ changes are made, so \\[highlight-changes-next-change] and
(define-globalized-minor-mode global-highlight-changes-mode
highlight-changes-mode highlight-changes-mode-turn-on)
-(define-obsolete-function-alias
- 'global-highlight-changes
- 'global-highlight-changes-mode "23.1")
-
(defun highlight-changes-mode-turn-on ()
"See if Highlight Changes mode should be turned on for this buffer.
This is called when `global-highlight-changes-mode' is turned on."
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index 98edacd6ec0..b521ddaa552 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -4,7 +4,7 @@
;; Author: Anders Holst <aho@sans.kth.se>
;; Maintainer: emacs-devel@gnu.org
-;; Version: 1.6
+;; Old-Version: 1.6
;; Keywords: abbrev convenience
;; This file is part of GNU Emacs.
@@ -411,14 +411,14 @@ undoes the expansion."
"Construct a function similar to `hippie-expand'.
Make it use the expansion functions in TRY-LIST. An optional second
argument VERBOSE non-nil makes the function verbose."
- `(function (lambda (arg)
- ,(concat
- "Try to expand text before point, using the following functions: \n"
- (mapconcat 'prin1-to-string (eval try-list) ", "))
- (interactive "P")
- (let ((hippie-expand-try-functions-list ,try-list)
- (hippie-expand-verbose ,verbose))
- (hippie-expand arg)))))
+ `(lambda (arg)
+ ,(concat
+ "Try to expand text before point, using the following functions: \n"
+ (mapconcat 'prin1-to-string (eval try-list) ", "))
+ (interactive "P")
+ (let ((hippie-expand-try-functions-list ,try-list)
+ (hippie-expand-verbose ,verbose))
+ (hippie-expand arg))))
;;; Here follows the try-functions and their requisites:
@@ -534,10 +534,10 @@ string). It returns t if a new completion is found, nil otherwise."
(setq he-expand-list
(and (not (equal he-search-string ""))
(sort (all-completions he-search-string obarray
- (function (lambda (sym)
+ (lambda (sym)
(or (boundp sym)
(fboundp sym)
- (symbol-plist sym)))))
+ (symbol-plist sym))))
'string-lessp)))))
(while (and he-expand-list
(he-string-member (car he-expand-list) he-tried-table))
@@ -563,10 +563,10 @@ otherwise."
(if (not (string= he-search-string ""))
(setq expansion
(try-completion he-search-string obarray
- (function (lambda (sym)
+ (lambda (sym)
(or (boundp sym)
(fboundp sym)
- (symbol-plist sym)))))))
+ (symbol-plist sym))))))
(if (or (eq expansion t)
(string= expansion he-search-string)
(he-string-member expansion he-tried-table))
@@ -821,10 +821,10 @@ string). It returns t if a new expansion is found, nil otherwise."
(he-init-string (he-dabbrev-beg) (point))
(setq he-expand-list
(and (not (equal he-search-string ""))
- (mapcar (function (lambda (sym)
+ (mapcar (lambda (sym)
(if (and (boundp sym) (vectorp (eval sym)))
(abbrev-expansion (downcase he-search-string)
- (eval sym)))))
+ (eval sym))))
(append '(local-abbrev-table
global-abbrev-table)
abbrev-table-name-list))))))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 08e52d63a26..ed2cd26f0de 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -11,9 +11,6 @@
;; Created: 2002-01-05
;; Description: htmlize a buffer/source tree with optional hyperlinks
;; URL: http://rtfm.etla.org/emacs/htmlfontify/
-;; Compatibility: Emacs23, Emacs22
-;; Incompatibility: Emacs19, Emacs20, Emacs21
-;; Last Updated: Thu 2009-11-19 01:31:21 +0000
;; This file is part of GNU Emacs.
@@ -136,8 +133,8 @@ main-content <=MAIN_CONTENT;\\n\" rtfm-section file style rtfm-section file))
\"s section[eg- emacs / p4-blame]:\\nD source-dir: \\nD output-dir: \")
(require \\='htmlfontify)
(hfy-load-tags-cache srcdir)
- (let ((hfy-page-header \\='rtfm-build-page-header)
- (hfy-page-footer \\='rtfm-build-page-footer)
+ (let ((hfy-page-header #\\='rtfm-build-page-header)
+ (hfy-page-footer #\\='rtfm-build-page-footer)
(rtfm-section section)
(hfy-index-file \"index\"))
(htmlfontify-run-etags srcdir)
@@ -151,7 +148,7 @@ main-content <=MAIN_CONTENT;\\n\" rtfm-section file style rtfm-section file))
:link '(info-link "(htmlfontify) Customization")
:prefix "hfy-")
-(defcustom hfy-page-header 'hfy-default-header
+(defcustom hfy-page-header #'hfy-default-header
"Function called to build the header of the HTML source.
This is called with two arguments (the filename relative to the top
level source directory being etag'd and fontified), and a string containing
@@ -159,7 +156,6 @@ the <style>...</style> text to embed in the document.
It should return a string that will be used as the header for the
htmlfontified version of the source file.\n
See also `hfy-page-footer'."
- :group 'htmlfontify
;; FIXME: Why place such a :tag everywhere? Isn't it imposing your
;; own Custom preference on your users? --Stef
:tag "page-header"
@@ -170,66 +166,57 @@ See also `hfy-page-footer'."
If non-nil, the index is split on the first letter of each tag.
Useful when the index would otherwise be large and take
a long time to render or be difficult to navigate."
- :group 'htmlfontify
:tag "split-index"
:type '(boolean))
-(defcustom hfy-page-footer 'hfy-default-footer
+(defcustom hfy-page-footer #'hfy-default-footer
"As `hfy-page-header', but generates the output footer.
It takes only one argument, the filename."
- :group 'htmlfontify
:tag "page-footer"
:type '(function))
(defcustom hfy-extn ".html"
"File extension used for output files."
- :group 'htmlfontify
:tag "extension"
:type '(string))
(defcustom hfy-src-doc-link-style "text-decoration: underline;"
"String to add to the `<style> a' variant of an htmlfontify CSS class."
- :group 'htmlfontify
:tag "src-doc-link-style"
:type '(string))
(defcustom hfy-src-doc-link-unstyle " text-decoration: none;"
"Regex to remove from the `<style> a' variant of an htmlfontify CSS class."
- :group 'htmlfontify
:tag "src-doc-link-unstyle"
- :type '(string))
+ :type '(regexp))
(defcustom hfy-link-extn nil
"File extension used for href links.
Useful where the htmlfontify output files are going to be processed
again, with a resulting change in file extension. If nil, then any
code using this should fall back to `hfy-extn'."
- :group 'htmlfontify
:tag "link-extension"
:type '(choice string (const nil)))
-(defcustom hfy-link-style-fun 'hfy-link-style-string
+(defcustom hfy-link-style-fun #'hfy-link-style-string
"Function to customize the appearance of hyperlinks.
Set this to a function, which will be called with one argument
\(a \"{ foo: bar; ...}\" CSS style-string) - it should return a copy of
its argument, altered so as to make any changes you want made for text which
is a hyperlink, in addition to being in the class to which that style would
normally be applied."
- :group 'htmlfontify
:tag "link-style-function"
:type '(function))
(defcustom hfy-index-file "hfy-index"
"Name (sans extension) of the tag definition index file produced during
fontification-and-hyperlinking."
- :group 'htmlfontify
:tag "index-file"
:type '(string))
(defcustom hfy-instance-file "hfy-instance"
"Name (sans extension) of the tag usage index file produced during
fontification-and-hyperlinking."
- :group 'htmlfontify
:tag "instance-file"
:type '(string))
@@ -237,25 +224,13 @@ fontification-and-hyperlinking."
"Regex to match (with a single back-reference per match) strings in HTML
which should be quoted with `hfy-html-quote' (and `hfy-html-quote-map')
to make them safe."
- :group 'htmlfontify
:tag "html-quote-regex"
:type '(regexp))
-(define-obsolete-variable-alias 'hfy-init-kludge-hooks 'hfy-init-kludge-hook
- "23.2")
-(defcustom hfy-init-kludge-hook '(hfy-kludge-cperl-mode)
- "List of functions to call when starting `htmlfontify-buffer' to do any
-kludging necessary to get highlighting modes to behave as you want, even
-when not running under a window system."
- :group 'htmlfontify
- :tag "init-kludge-hooks"
- :type '(hook))
-
(define-obsolete-variable-alias 'hfy-post-html-hooks 'hfy-post-html-hook "24.3")
(defcustom hfy-post-html-hook nil
"List of functions to call after creating and filling the HTML buffer.
These functions will be called with the HTML buffer as the current buffer."
- :group 'htmlfontify
:tag "post-html-hooks"
:options '(set-auto-mode)
:type '(hook))
@@ -267,7 +242,6 @@ potentially non-current face information doesn't necessarily work for
`default').\n
Example: I customize this to:\n
\((t :background \"black\" :foreground \"white\" :family \"misc-fixed\"))"
- :group 'htmlfontify
:tag "default-face-definition"
:type '(alist))
@@ -281,7 +255,6 @@ in order, to:\n
1 - The tag
2 - The line
3 - The char (point) at which the tag occurs."
- :group 'htmlfontify
:tag "etag-regex"
:type '(regexp))
@@ -290,7 +263,6 @@ in order, to:\n
("&" "&amp;" )
(">" "&gt;" ))
"Alist of char -> entity mappings used to make the text HTML-safe."
- :group 'htmlfontify
:tag "html-quote-map"
:type '(alist :key-type (string)))
(defconst hfy-e2x-etags-cmd "for src in `find . -type f`;
@@ -332,7 +304,6 @@ done;")
hfy-etags-cmd-alist-default
"Alist of possible shell commands that will generate etags output that
`htmlfontify' can use. `%s' will be replaced by `hfy-etags-bin'."
- :group 'htmlfontify
:tag "etags-cmd-alist"
:type '(alist :key-type (string) :value-type (string)))
@@ -340,13 +311,11 @@ done;")
"Location of etags binary (we begin by assuming it's in your path).\n
Note that if etags is not in your path, you will need to alter the shell
commands in `hfy-etags-cmd-alist'."
- :group 'htmlfontify
:tag "etags-bin"
:type '(file))
(defcustom hfy-shell-file-name "/bin/sh"
"Shell (Bourne or compatible) to invoke for complex shell operations."
- :group 'htmlfontify
:tag "shell-file-name"
:type '(file))
@@ -358,7 +327,6 @@ commands in `hfy-etags-cmd-alist'."
point-entered
point-left)
"Properties to omit when copying a fontified buffer for HTML transformation."
- :group 'htmlfontify
:tag "ignored-properties"
:type '(repeat symbol))
@@ -387,7 +355,6 @@ file for the whole source tree from there on down. The command should emit
the etags output on stdout.\n
Two canned commands are provided - they drive Emacs's etags and
exuberant-ctags' etags respectively."
- :group 'htmlfontify
:tag "etags-command"
:type (let ((clist (list '(string))))
(dolist (C hfy-etags-cmd-alist)
@@ -398,14 +365,12 @@ exuberant-ctags' etags respectively."
"Command to run with the name of a file, to see whether it is a text file
or not. The command should emit a string containing the word `text' if
the file is a text file, and a string not containing `text' otherwise."
- :group 'htmlfontify
:tag "istext-command"
:type '(string))
(defcustom hfy-find-cmd
"find . -type f \\! -name \\*~ \\! -name \\*.flc \\! -path \\*/CVS/\\*"
"Find command used to harvest a list of files to attempt to fontify."
- :group 'htmlfontify
:tag "find-command"
:type '(string))
@@ -434,7 +399,6 @@ of these values in the specification key constitutes a match, eg:\n
((type tty) (class color))\n
and so on."
:type '(alist :key-type (symbol) :value-type (symbol))
- :group 'htmlfontify
:tag "display-class"
:options '((type (choice (const :tag "X11" x-toolkit)
(const :tag "Terminal" tty )
@@ -481,7 +445,6 @@ which can never slow you down, but may result in incomplete fontification."
(const :tag "div-wrapper" div-wrapper )
(const :tag "keep-overlays" keep-overlays )
(const :tag "body-text-only" body-text-only ))
- :group 'htmlfontify
:tag "optimizations")
(defvar hfy-tags-cache nil
@@ -593,19 +556,17 @@ If a window system is unavailable, calls `hfy-fallback-color-values'."
'(1 2 3))
;;(message ">> %s" color)
(if window-system
- (if (fboundp 'color-values)
- (color-values color)
- ;;(message "[%S]" window-system)
- (x-color-values color))
+ (color-values color)
;; blarg - tty colors are no good - go fetch some X colors:
(hfy-fallback-color-values color))))
-(define-obsolete-function-alias 'hfy-colour-vals 'hfy-color-vals "27.1")
+(define-obsolete-function-alias 'hfy-colour-vals #'hfy-color-vals "27.1")
(defvar hfy-cperl-mode-kludged-p nil)
(defun hfy-kludge-cperl-mode ()
"CPerl mode does its damnedest not to do some of its fontification when not
in a windowing system - try to trick it..."
+ (declare (obsolete nil "28.1"))
(if (not hfy-cperl-mode-kludged-p)
(progn (if (not window-system)
(let ((window-system 'htmlfontify))
@@ -728,7 +689,7 @@ STYLE is the inline CSS stylesheet (or tag referring to an external sheet)."
--> </script>
</head>
<body onload=\"stripe('index'); return true;\">\n"
- (mapconcat 'hfy-html-quote (mapcar 'char-to-string file) "") style))
+ (mapconcat #'hfy-html-quote (mapcar #'char-to-string file) "") style))
(defun hfy-default-footer (_file)
"Default value for `hfy-page-footer'.
@@ -766,24 +727,24 @@ may happen."
(let ((white (mapcar (lambda (I) (float (1+ I))) (hfy-color-vals "white")))
(rgb16 (mapcar (lambda (I) (float (1+ I))) (hfy-color-vals color))))
(if rgb16
- ;;(apply 'format "rgb(%d, %d, %d)"
+ ;;(apply #'format "rgb(%d, %d, %d)"
;; Use #rrggbb instead, it is smaller
- (apply 'format "#%02x%02x%02x"
+ (apply #'format "#%02x%02x%02x"
(mapcar (lambda (X)
(* (/ (nth X rgb16)
- (nth X white)) 255))
+ (nth X white))
+ 255))
'(0 1 2))))))
(defun hfy-family (family) (list (cons "font-family" family)))
(defun hfy-bgcol (color) (list (cons "background" (hfy-triplet color))))
(defun hfy-color (color) (list (cons "color" (hfy-triplet color))))
-(define-obsolete-function-alias 'hfy-colour 'hfy-color "27.1")
+(define-obsolete-function-alias 'hfy-colour #'hfy-color "27.1")
(defun hfy-width (width) (list (cons "font-stretch" (symbol-name width))))
(defcustom hfy-font-zoom 1.05
"Font scaling from Emacs to HTML."
- :type 'float
- :group 'htmlfontify)
+ :type 'float)
(defun hfy-size (height)
"Derive a CSS font-size specifier from an Emacs font :height attribute HEIGHT.
@@ -1062,7 +1023,7 @@ haven't encountered them yet. Returns a `hfy-style-assoc'."
(when (string-match "pt" (cdr css)) (setq x t)))
(setq r (nconc r (list css)))))
;;(message "r: %S" r)
- (setq n (apply '* m))
+ (setq n (apply #'* m))
(nconc r (hfy-size (if x (round n) (* n 1.0)))) ))
(defun hfy-face-resolve-face (fn)
@@ -1073,7 +1034,7 @@ then the specification is returned unchanged."
((facep fn)
(hfy-face-attr-for-class fn hfy-display-class))
;; FIXME: is this necessary? Faces can be symbols, but
- ;; not symbols refering to other symbols?
+ ;; not symbols referring to other symbols?
((and (symbolp fn)
(facep (symbol-value fn)))
(hfy-face-attr-for-class
@@ -1152,9 +1113,9 @@ See also `hfy-face-to-css'."
(push (car E) seen)
(format " %s: %s; " (car E) (cdr E)))))
css-list)))
- (cons (hfy-css-name fn) (format "{%s}" (apply 'concat css-text)))) )
+ (cons (hfy-css-name fn) (format "{%s}" (apply #'concat css-text)))) )
-(defvar hfy-face-to-css 'hfy-face-to-css-default
+(defvar hfy-face-to-css #'hfy-face-to-css-default
"Handler for mapping faces to styles.
The signature of the handler is of the form \(lambda (FN) ...).
FN is a font or `defface' specification (cf
@@ -1510,7 +1471,7 @@ Uses `hfy-link-style-fun' to do this."
;; Fix-me: Add handling of page breaks here + scan for ^L
;; where appropriate.
(format "body, pre %s\n" (cddr (assq 'default css)))
- (apply 'concat
+ (apply #'concat
(mapcar
(lambda (style)
(format
@@ -1611,7 +1572,7 @@ Insert \"</span>\". See `hfy-end-span-handler' for more
information."
(insert "</span>"))
-(defvar hfy-begin-span-handler 'hfy-begin-span
+(defvar hfy-begin-span-handler #'hfy-begin-span
"Handler to begin a span of text.
The signature of the handler is \(lambda (STYLE TEXT-BLOCK
TEXT-ID TEXT-BEGINS-BLOCK-P) ...). The handler must insert
@@ -1640,7 +1601,7 @@ behavior.
The default handler is `hfy-begin-span'.")
-(defvar hfy-end-span-handler 'hfy-end-span
+(defvar hfy-end-span-handler #'hfy-end-span
"Handler to end a span of text.
The signature of the handler is \(lambda () ...). The handler
must insert appropriate tags to end a span of text.
@@ -1821,33 +1782,7 @@ fontified. This is a simple convenience wrapper around
(htmlfontify-buffer)
(buffer-string))))
-(defun hfy-force-fontification ()
- "Try to force font-locking even when it is optimized away."
- (run-hooks 'hfy-init-kludge-hook)
- (eval-and-compile (require 'font-lock))
- (if (boundp 'font-lock-cache-position)
- (or font-lock-cache-position
- (setq font-lock-cache-position (make-marker))))
- (cond
- (noninteractive
- (message "hfy batch mode (%s:%S)"
- (or (buffer-file-name) (buffer-name)) major-mode)
- (if (fboundp 'font-lock-ensure) ; Emacs >= 25.1
- (font-lock-ensure)
- (when font-lock-defaults
- ; Silence "interactive use only" warning on Emacs >= 25.1.
- (with-no-warnings (font-lock-fontify-buffer)))))
- ((and (fboundp #'jit-lock-fontify-now)
- (bound-and-true-p jit-lock-mode))
- (message "hfy jit-lock mode (%S %S)" window-system major-mode)
- (jit-lock-fontify-now))
- (t
- (message "hfy interactive mode (%S %S)" window-system major-mode)
- ;; If jit-lock is not in use, then the buffer is already fontified!
- ;; (when (and font-lock-defaults
- ;; font-lock-mode)
- ;; (font-lock-fontify-region (point-min) (point-max) nil))
- )))
+(define-obsolete-function-alias 'hfy-force-fontification #'font-lock-ensure "28.1")
;;;###autoload
(defun htmlfontify-buffer (&optional srcdir file)
@@ -1875,8 +1810,7 @@ hyperlinks as appropriate."
(setq file (match-string 1 file)))) )
(if (not (hfy-opt 'skip-refontification))
- (save-excursion ;; Keep region
- (hfy-force-fontification)))
+ (font-lock-ensure))
(if (called-interactively-p 'any) ;; display the buffer in interactive mode:
(switch-to-buffer (hfy-fontify-buffer srcdir file))
(hfy-fontify-buffer srcdir file)))
@@ -1934,7 +1868,7 @@ adding an extension of `hfy-extn'. Fontification is actually done by
;; FIXME: Shouldn't this use expand-file-name? --Stef
(setq target (concat dstdir "/" file))
(hfy-make-directory (hfy-dirname target))
- (if (not (hfy-opt 'skip-refontification)) (hfy-force-fontification))
+ (if (not (hfy-opt 'skip-refontification)) (font-lock-ensure))
(if (or (hfy-fontified-p) (hfy-text-p srcdir file))
(progn (setq html (hfy-fontify-buffer srcdir file))
(set-buffer html)
@@ -2392,7 +2326,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
;; (custom-save-delete 'hfy-set-hooks)
;; (let ((standard-output (current-buffer)))
;; (princ "(hfy-set-hooks\n;;auto-generated, only one copy allowed\n")
-;; (mapatoms 'hfy-pp-hook)
+;; (mapatoms #'hfy-pp-hook)
;; (insert "\n)")
;; )
;; )
@@ -2419,7 +2353,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
;; FIXME: This saving&restoring of global customization
;; variables can interfere with other customization settings for
;; those vars (in .emacs or in Customize).
- (mapc 'hfy-save-initvar
+ (mapc #'hfy-save-initvar
'(auto-mode-alist interpreter-mode-alist))
(princ ")\n")
(indent-region start-pos (point) nil))
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index bfb9787a96d..80c5b073985 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -504,7 +504,7 @@ format. See `ibuffer-update-saved-filters-format' and
(ibuffer-forward-line 0))
(defun ibuffer--maybe-erase-shell-cmd-output ()
- (let ((buf (get-buffer "*Shell Command Output*")))
+ (let ((buf (get-buffer shell-command-buffer-name)))
(when (and (buffer-live-p buf)
(not shell-command-dont-erase-buffer)
(not (zerop (buffer-size buf))))
@@ -517,7 +517,7 @@ format. See `ibuffer-update-saved-filters-format' and
:opstring "Shell command executed on"
:before (ibuffer--maybe-erase-shell-cmd-output)
:modifier-p nil)
- (let ((out-buf (get-buffer-create "*Shell Command Output*")))
+ (let ((out-buf (get-buffer-create shell-command-buffer-name)))
(with-current-buffer out-buf (goto-char (point-max)))
(call-shell-region (point-min) (point-max)
command nil out-buf)))
@@ -542,7 +542,7 @@ format. See `ibuffer-update-saved-filters-format' and
:modifier-p nil)
(let ((file (and (not (buffer-modified-p))
buffer-file-name))
- (out-buf (get-buffer-create "*Shell Command Output*")))
+ (out-buf (get-buffer-create shell-command-buffer-name)))
(unless (and file (file-exists-p file))
(setq file
(make-temp-file
@@ -1234,14 +1234,12 @@ Called interactively, accept a comma separated list of mode names."
(symbol-name (buffer-local-value
'major-mode buf)))))
(mapcar #'intern
- (completing-read-multiple
- (if default
- (format "Filter by major mode (default %s): " default)
- "Filter by major mode: ")
- obarray
- (lambda (e)
- (string-match "-mode\\'" (if (symbolp e) (symbol-name e) e)))
- t nil nil default)))
+ (completing-read-multiple
+ (format-prompt "Filter by major mode" default)
+ obarray
+ (lambda (e)
+ (string-match "-mode\\'" (if (symbolp e) (symbol-name e) e)))
+ t nil nil default)))
:accept-list t)
(eq qualifier (buffer-local-value 'major-mode buf)))
@@ -1259,11 +1257,9 @@ currently used by buffers."
(symbol-name (buffer-local-value
'major-mode buf)))))
(mapcar #'intern
- (completing-read-multiple
- (if default
- (format "Filter by major mode (default %s): " default)
- "Filter by major mode: ")
- (ibuffer-list-buffer-modes) nil t nil nil default)))
+ (completing-read-multiple
+ (format-prompt "Filter by major mode" default)
+ (ibuffer-list-buffer-modes) nil t nil nil default)))
:accept-list t)
(eq qualifier (buffer-local-value 'major-mode buf)))
@@ -1881,9 +1877,7 @@ Otherwise buffers whose name matches an element of
'major-mode buf)))))
(list (intern
(completing-read
- (if default
- (format "Mark by major mode (default %s): " default)
- "Mark by major mode: ")
+ (format-prompt "Mark by major mode" default)
(ibuffer-list-buffer-modes) nil t nil nil default)))))
(ibuffer-mark-on-buffer
#'(lambda (buf)
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 851b25f9ec0..8ff3b56c5e6 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -339,6 +339,8 @@ directory, like `default-directory'."
(defcustom ibuffer-load-hook nil
"Hook run when Ibuffer is loaded."
:type 'hook)
+(make-obsolete-variable 'ibuffer-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom ibuffer-marked-face 'warning
"Face used for displaying marked buffers."
@@ -1595,7 +1597,7 @@ If point is on a group name, this function operates on that group."
(defun ibuffer-compile-make-substring-form (strvar maxvar from-end-p)
(if from-end-p
;; FIXME: not sure if this case is correct (Bug#24972)
- `(truncate-string-to-width str strlen (- strlen ,maxvar) nil ?\s)
+ `(truncate-string-to-width str strlen (- strlen ,maxvar) ?\s)
`(truncate-string-to-width ,strvar ,maxvar nil ?\s)))
(defun ibuffer-compile-make-format-form (strvar widthform alignment)
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 3747ae3d281..4e546807b7f 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -75,7 +75,11 @@ everything preceding the ~/ is discarded so the interactive
selection process starts again from the user's $HOME.")
(defcustom icomplete-show-matches-on-no-input nil
- "When non-nil, show completions when first prompting for input."
+ "When non-nil, show completions when first prompting for input.
+This also means that if you traverse the list of completions with
+commands like `C-.' and just hit RET without typing any
+characters, the match under point will be chosen instead of the
+default."
:type 'boolean
:version "24.4")
@@ -153,12 +157,22 @@ icompletion is occurring."
(defvar icomplete-minibuffer-map
(let ((map (make-sparse-keymap)))
(define-key map [?\M-\t] 'icomplete-force-complete)
+ (define-key map [remap minibuffer-complete-and-exit] 'icomplete-ret)
(define-key map [?\C-j] 'icomplete-force-complete-and-exit)
(define-key map [?\C-.] 'icomplete-forward-completions)
(define-key map [?\C-,] 'icomplete-backward-completions)
map)
"Keymap used by `icomplete-mode' in the minibuffer.")
+(defun icomplete-ret ()
+ "Exit minibuffer for icomplete."
+ (interactive)
+ (if (and icomplete-show-matches-on-no-input
+ (car completion-all-sorted-completions)
+ (eql (icomplete--field-end) (icomplete--field-beg)))
+ (icomplete-force-complete-and-exit)
+ (minibuffer-complete-and-exit)))
+
(defun icomplete-force-complete-and-exit ()
"Complete the minibuffer with the longest possible match and exit.
Use the first of the matches if there are any displayed, and use
@@ -465,38 +479,80 @@ Usually run by inclusion in `minibuffer-setup-hook'."
with beg = (icomplete--field-beg)
with end = (icomplete--field-end)
with all = (completion-all-sorted-completions beg end)
+ ;; Icomplete mode re-sorts candidates, bubbling the default to
+ ;; top if it's found somewhere down the list. This loop's
+ ;; iteration variable, `fn' iterates through these "bubble up
+ ;; predicates" which may vary depending on specific
+ ;; `completing-read' invocations, described below:
for fn in (cond ((and minibuffer-default
(stringp minibuffer-default) ; bug#38992
(= (icomplete--field-end) (icomplete--field-beg)))
- ;; When we have a non-nil string default and
- ;; no input whatsoever: we want to make sure
- ;; that default is bubbled to the top so that
- ;; `icomplete-force-complete-and-exit' will
- ;; select it (do that even if the match
- ;; doesn't match the completion perfectly.
- `(,(lambda (comp)
+ ;; Here, we have a non-nil string default and
+ ;; no input whatsoever. We want to make sure
+ ;; that the default is bubbled to the top so
+ ;; that `icomplete-force-complete-and-exit'
+ ;; will select it. We want to do that even if
+ ;; the match doesn't match the completion
+ ;; perfectly.
+ ;;
+ `(;; The first predicate ensures that:
+ ;;
+ ;; (completing-read "thing? " '("foo" "bar")
+ ;; nil nil nil nil "bar")
+ ;;
+ ;; Has "bar" at the top, so RET will select
+ ;; it, as desired.
+ ,(lambda (comp)
(equal minibuffer-default comp))
+ ;; Why do we need this second predicate?
+ ;; Because that'll make things like M-x man
+ ;; RET RET, when invoked with point on the
+ ;; "bar" word, behave correctly. There, the
+ ;; default doesn't quite match any
+ ;; candidate. So:
+ ;;
+ ;; (completing-read "Man entry? " '("foo(1)" "bar(1)")
+ ;; nil nil nil nil "bar")
+ ;;
+ ;; Will place "bar(1)" on top, and RET will
+ ;; select it -- again, as desired.
+ ;;
+ ;; FIXME: it's arguable that this second
+ ;; behaviour should be a property of the
+ ;; completion table and not the completion
+ ;; frontend such as we have done
+ ;; here. However, it seems generically
+ ;; useful for a very broad spectrum of
+ ;; cases.
,(lambda (comp)
(string-prefix-p minibuffer-default comp))))
((and fido-mode
(not minibuffer-default)
(eq (icomplete--category) 'file))
- ;; `fido-mode' has some extra file-sorting
- ;; semantics even if there isn't a default,
- ;; which is to bubble "./" to the top if it
- ;; exists. This makes M-x dired RET RET go to
- ;; the directory of current file, which is
- ;; what vanilla Emacs and `ido-mode' both do.
+ ;; When there isn't a default, `fido-mode'
+ ;; specifically also has some extra
+ ;; file-sorting semantics inherited from Ido.
+ ;; Those make the directory "./" bubble to the
+ ;; top (if it exists). This makes M-x dired
+ ;; RET RET go to the directory of current
+ ;; file, which is non-Icomplete vanilla Emacs
+ ;; and `ido-mode' both do.
`(,(lambda (comp)
(string= "./" comp)))))
- thereis (cl-loop
- for l on all
- while (consp (cdr l))
- for comp = (cadr l)
- when (funcall fn comp)
- do (setf (cdr l) (cddr l))
- and return
- (completion--cache-all-sorted-completions beg end (cons comp all)))
+ ;; After we have setup the predicates, look for a completion
+ ;; matching one of them and bubble up it, destructively on
+ ;; `completion-all-sorted-completions' (unless that completion
+ ;; happens to be already on top).
+ thereis (or
+ (and (funcall fn (car all)) all)
+ (cl-loop
+ for l on all
+ while (consp (cdr l))
+ for comp = (cadr l)
+ when (funcall fn comp)
+ do (setf (cdr l) (cddr l))
+ and return
+ (completion--cache-all-sorted-completions beg end (cons comp all))))
finally return all)))
diff --git a/lisp/ido.el b/lisp/ido.el
index 7198649e5a5..c83b700e656 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -243,7 +243,7 @@
;; current frame are put at the end of the list. A hook exists to
;; allow other functions to order the list. For example, if you add:
;;
-;; (add-hook 'ido-make-buffer-list-hook 'ido-summary-buffers-to-end)
+;; (add-hook 'ido-make-buffer-list-hook #'ido-summary-buffers-to-end)
;;
;; then all files matching "Summary" are moved to the end of the
;; list. (I find this handy for keeping the INBOX Summary and so on
@@ -355,8 +355,8 @@ The following values are possible:
Setting this variable directly does not take effect;
use either \\[customize] or the function `ido-mode'."
:set #'(lambda (_symbol value)
- (ido-mode value))
- :initialize 'custom-initialize-default
+ (ido-mode (or value 0)))
+ :initialize #'custom-initialize-default
:require 'ido
:link '(emacs-commentary-link "ido.el")
:set-after '(ido-save-directory-list-file
@@ -366,13 +366,11 @@ use either \\[customize] or the function `ido-mode'."
:type '(choice (const :tag "Turn on only buffer" buffer)
(const :tag "Turn on only file" file)
(const :tag "Turn on both buffer and file" both)
- (const :tag "Switch off all" nil))
- :group 'ido)
+ (const :tag "Switch off all" nil)))
(defcustom ido-case-fold case-fold-search
"Non-nil if searching of buffer and file names should ignore case."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-ignore-buffers
'("\\` ")
@@ -380,8 +378,7 @@ use either \\[customize] or the function `ido-mode'."
For example, traditional behavior is not to list buffers whose names begin
with a space, for which the regexp is `\\\\=` '. See the source file for
example functions that filter buffer names."
- :type '(repeat (choice regexp function))
- :group 'ido)
+ :type '(repeat (choice regexp function)))
(defcustom ido-ignore-files
'("\\`CVS/" "\\`#" "\\`.#" "\\`\\.\\./" "\\`\\./")
@@ -389,19 +386,16 @@ example functions that filter buffer names."
For example, traditional behavior is not to list files whose names begin
with a #, for which the regexp is `\\\\=`#'. See the source file for
example functions that filter filenames."
- :type '(repeat (choice regexp function))
- :group 'ido)
+ :type '(repeat (choice regexp function)))
(defcustom ido-ignore-extensions t
"Non-nil means ignore files in `completion-ignored-extensions' list."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-show-dot-for-dired nil
"Non-nil means to always put . as the first item in file name lists.
This allows the current directory to be opened immediately with `dired'."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-file-extensions-order nil
"List of file extensions specifying preferred order of file selections.
@@ -409,21 +403,18 @@ Each element is either a string with `.' as the first char, an empty
string matching files without extension, or t which is the default order
for files with an unlisted file extension."
:type '(repeat (choice string
- (const :tag "Default order" t)))
- :group 'ido)
+ (const :tag "Default order" t))))
(defcustom ido-ignore-directories
'("\\`CVS/" "\\`\\.\\./" "\\`\\./")
"List of regexps or functions matching sub-directory names to ignore."
- :type '(repeat (choice regexp function))
- :group 'ido)
+ :type '(repeat (choice regexp function)))
(defcustom ido-ignore-directories-merge nil
"List of regexps or functions matching directory names to ignore during merge.
Directory names matched by one of the regexps in this list are not inserted
in merged file and directory lists."
- :type '(repeat (choice regexp function))
- :group 'ido)
+ :type '(repeat (choice regexp function)))
;; Examples for setting the value of ido-ignore-buffers
;;(defun ido-ignore-c-mode (name)
@@ -453,8 +444,7 @@ Possible values:
(const :tag "Display (no select) in other window" display)
(const :tag "Visit in other frame" other-frame)
(const :tag "Ask to visit in other frame" maybe-frame)
- (const :tag "Raise frame if already visited" raise-frame))
- :group 'ido)
+ (const :tag "Raise frame if already visited" raise-frame)))
(defcustom ido-default-buffer-method 'raise-frame
"How to switch to new buffer when using `ido-switch-buffer'.
@@ -464,38 +454,33 @@ See `ido-default-file-method' for details."
(const :tag "Display (no select) in other window" display)
(const :tag "Show in other frame" other-frame)
(const :tag "Ask to show in other frame" maybe-frame)
- (const :tag "Raise frame if already shown" raise-frame))
- :group 'ido)
+ (const :tag "Raise frame if already shown" raise-frame)))
(defcustom ido-enable-flex-matching nil
"Non-nil means that Ido will do flexible string matching.
Flexible matching means that if the entered string does not
match any item, any item containing the entered characters
in the given sequence will match."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-enable-regexp nil
"Non-nil means that Ido will do regexp matching.
Value can be toggled within Ido using `ido-toggle-regexp'."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-enable-prefix nil
"Non-nil means only match if the entered text is a prefix of file name.
This behavior is like the standard Emacs completion.
If nil, match if the entered text is an arbitrary substring.
Value can be toggled within Ido using `ido-toggle-prefix'."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-enable-dot-prefix nil
"Non-nil means to match leading dot as prefix.
I.e. hidden files and buffers will match only if you type a dot
as first char even if `ido-enable-prefix' is nil."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
;; See https://debbugs.gnu.org/2042 for more info.
(defcustom ido-buffer-disable-smart-matches t
@@ -506,30 +491,29 @@ By default, Ido arranges matches in the following order:
which can get in the way for buffer switching."
:version "24.3"
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-confirm-unique-completion nil
"Non-nil means that even a unique completion must be confirmed.
This means that \\[ido-complete] must always be followed by \\[ido-exit-minibuffer]
even when there is only one unique completion."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
-(defcustom ido-cannot-complete-command 'ido-completion-help
+(defcustom ido-cannot-complete-command #'ido-completion-auto-help
"Command run when `ido-complete' can't complete any more.
The most useful values are `ido-completion-help', which pops up a
-window with completion alternatives, or `ido-next-match' or
-`ido-prev-match', which cycle the buffer list."
- :type 'function
- :group 'ido)
+window with completion alternatives; `ido-completion-auto-help',
+which does the same but respects the value of
+`completion-auto-help'; and `ido-next-match' or `ido-prev-match',
+which cycle the buffer list."
+ :version "28.1"
+ :type 'function)
(defcustom ido-record-commands t
"Non-nil means that Ido will record commands in command history.
Note that the non-Ido equivalent command is recorded."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-max-prospects 12
"Upper limit of the prospect list if non-zero.
@@ -537,8 +521,7 @@ Zero means no limit for the prospect list.
For a long list of prospects, building the full list for the
minibuffer can take a non-negligible amount of time; setting this
variable reduces that time."
- :type 'integer
- :group 'ido)
+ :type 'integer)
(defcustom ido-max-file-prompt-width 0.35
"Upper limit of the prompt string.
@@ -550,8 +533,7 @@ the frame width."
(integer :tag "Characters" :value 20)
(restricted-sexp :tag "Fraction of frame width"
:value 0.35
- :match-alternatives (ido-fractionp)))
- :group 'ido)
+ :match-alternatives (ido-fractionp))))
(defcustom ido-max-window-height nil
"Non-nil specifies a value to override `max-mini-window-height'."
@@ -561,28 +543,24 @@ the frame width."
(restricted-sexp
:tag "Fraction of window height"
:value 0.25
- :match-alternatives (ido-fractionp)))
- :group 'ido)
+ :match-alternatives (ido-fractionp))))
(defcustom ido-enable-last-directory-history t
"Non-nil means that Ido will remember latest selected directory names.
See `ido-last-directory-list' and `ido-save-directory-list-file'."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-max-work-directory-list 50
"Maximum number of working directories to record.
This is the list of directories where files have most recently been opened.
See `ido-work-directory-list' and `ido-save-directory-list-file'."
- :type 'integer
- :group 'ido)
+ :type 'integer)
(defcustom ido-work-directory-list-ignore-regexps nil
"List of regexps matching directories which should not be recorded.
Directory names matched by one of the regexps in this list are not inserted in
the `ido-work-directory-list' list."
- :type '(repeat regexp)
- :group 'ido)
+ :type '(repeat regexp))
(defcustom ido-use-filename-at-point nil
@@ -592,52 +570,44 @@ If found, use that as the starting point for filename selection."
:type '(choice
(const :tag "Disabled" nil)
(const :tag "Guess filename" guess)
- (other :tag "Use literal filename" t))
- :group 'ido)
+ (other :tag "Use literal filename" t)))
(defcustom ido-use-url-at-point nil
"Non-nil means that ido shall look for a URL at point.
If found, call `find-file-at-point' to visit it."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-enable-tramp-completion t
"Non-nil means that Ido shall perform tramp method and server name completion.
A tramp file name uses the following syntax: /method:user@host:filename."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-record-ftp-work-directories t
"Non-nil means record FTP file names in the work directory list."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-merge-ftp-work-directories nil
"If nil, merging ignores FTP file names in the work directory list."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-cache-ftp-work-directory-time 1.0
"Maximum time to cache contents of an FTP directory (in hours).
\\<ido-file-completion-map>
Use \\[ido-reread-directory] in prompt to refresh list.
If zero, FTP directories are not cached."
- :type 'number
- :group 'ido)
+ :type 'number)
(defcustom ido-slow-ftp-hosts nil
"List of slow FTP hosts where Ido prompting should not be used.
If an FTP host is on this list, Ido automatically switches to the non-Ido
equivalent function, e.g. `find-file' rather than `ido-find-file'."
- :type '(repeat string)
- :group 'ido)
+ :type '(repeat string))
(defcustom ido-slow-ftp-host-regexps nil
"List of regexps matching slow FTP hosts (see `ido-slow-ftp-hosts')."
- :type '(repeat regexp)
- :group 'ido)
+ :type '(repeat regexp))
(defvar ido-unc-hosts-cache t
"Cached value from the function `ido-unc-hosts'.")
@@ -652,66 +622,56 @@ hosts on first use of UNC path."
(function :tag "Your own function"))
:set #'(lambda (symbol value)
(set symbol value)
- (setq ido-unc-hosts-cache t))
- :group 'ido)
+ (setq ido-unc-hosts-cache t)))
(defcustom ido-downcase-unc-hosts t
"Non-nil if UNC host names should be downcased."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-ignore-unc-host-regexps nil
"List of regexps matching UNC hosts to ignore.
Case is ignored if `ido-downcase-unc-hosts' is set."
- :type '(repeat regexp)
- :group 'ido)
+ :type '(repeat regexp))
(defcustom ido-cache-unc-host-shares-time 8.0
"Maximum time to cache shares of an UNC host (in hours).
\\<ido-file-completion-map>
Use \\[ido-reread-directory] in prompt to refresh list.
If zero, UNC host shares are not cached."
- :type 'number
- :group 'ido)
+ :type 'number)
(defcustom ido-max-work-file-list 10
"Maximum number of names of recently opened files to record.
This is the list of the file names (sans directory) which have most recently
been opened. See `ido-work-file-list' and `ido-save-directory-list-file'."
- :type 'integer
- :group 'ido)
+ :type 'integer)
(defcustom ido-work-directory-match-only t
"Non-nil means to skip non-matching directories in the directory history.
When some text is already entered at the `ido-find-file' prompt, using
\\[ido-prev-work-directory] or \\[ido-next-work-directory] will skip directories
without any matching entries."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-auto-merge-work-directories-length 0
"Automatically switch to merged work directories during file name input.
The value is number of characters to type before switching to merged mode.
If zero, the switch happens when no matches are found in the current directory.
Automatic merging is disabled if the value is negative."
- :type 'integer
- :group 'ido)
+ :type 'integer)
(defcustom ido-auto-merge-delay-time 0.70
"Delay in seconds to wait for more input before doing auto merge."
- :type 'number
- :group 'ido)
+ :type 'number)
(defcustom ido-auto-merge-inhibit-characters-regexp "[][*?~]"
"Regexp matching characters which should inhibit automatic merging.
When a (partial) file name matches this regexp, merging is inhibited."
- :type 'regexp
- :group 'ido)
+ :type 'regexp)
(defcustom ido-merged-indicator "^"
"The string appended to first choice if it has multiple directory choices."
- :type 'string
- :group 'ido)
+ :type 'string)
(defcustom ido-max-dir-file-cache 100
"Maximum number of working directories to be cached.
@@ -723,8 +683,7 @@ modification times, so you may choose to disable caching on such
systems, or explicitly refresh the cache contents using the command
`ido-reread-directory' command (\\[ido-reread-directory]) in the minibuffer.
See also `ido-dir-file-cache' and `ido-save-directory-list-file'."
- :type 'integer
- :group 'ido)
+ :type 'integer)
(defcustom ido-max-directory-size nil
"Maximum size (in bytes) for directories to use Ido completion.
@@ -732,21 +691,18 @@ See also `ido-dir-file-cache' and `ido-save-directory-list-file'."
If you enter a directory with a size larger than this size, Ido will
not provide the normal completion. To show the completions, use \\[ido-toggle-ignore]."
:type '(choice (const :tag "No limit" nil)
- (integer :tag "Size in bytes" 30000))
- :group 'ido)
+ (integer :tag "Size in bytes" 30000)))
(defcustom ido-big-directories nil
"List of directory pattern strings that should be considered big.
Ido won't attempt to list the contents of directories matching
any of these regular expressions when completing file names."
:type '(repeat regexp)
- :group 'ido
:version "27.1")
(defcustom ido-rotate-file-list-default nil
"Non-nil means that Ido will always rotate file list to get default in front."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-enter-matching-directory 'only
"Additional methods to enter sub-directory of first/only matching item.
@@ -758,8 +714,7 @@ matching item, even without typing a slash."
:type '(choice (const :tag "Never" nil)
(const :tag "Slash enters first directory" first)
(const :tag "Slash enters first and only directory" only)
- (other :tag "Always enter unique directory" t))
- :group 'ido)
+ (other :tag "Always enter unique directory" t)))
(defcustom ido-create-new-buffer 'prompt
"Specify whether a new buffer is created if no buffer matches substring.
@@ -767,21 +722,18 @@ Choices are `always' to create new buffers unconditionally, `prompt' to
ask user whether to create buffer, or `never' to never create new buffer."
:type '(choice (const always)
(const prompt)
- (const never))
- :group 'ido)
+ (const never)))
(defcustom ido-setup-hook nil
"Hook run after the Ido variables and keymap have been setup.
The dynamic variable `ido-cur-item' contains the current type of item that
is read by Ido; possible values are file, dir, buffer, and list.
Additional keys can be defined in `ido-completion-map'."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defcustom ido-separator nil
"String used by Ido to separate the alternatives in the minibuffer."
- :type '(choice string (const nil))
- :group 'ido)
+ :type '(choice string (const nil)))
(make-obsolete-variable 'ido-separator
"set 3rd element of `ido-decorations' instead." nil)
@@ -802,8 +754,7 @@ can be completed using TAB,
11th element is displayed to confirm creating new file or buffer.
12th and 13th elements (if present) are used as brackets around the sole
remaining completion. If absent, elements 5 and 6 are used instead."
- :type '(repeat string)
- :group 'ido)
+ :type '(repeat string))
(defcustom ido-use-virtual-buffers nil
"If non-nil, refer to past (\"virtual\") buffers as well as existing ones.
@@ -827,71 +778,60 @@ enabled if this variable is configured to a non-nil value."
:version "24.1"
:type '(choice (const :tag "Always" t)
(const :tag "Automatic" auto)
- (const :tag "Never" nil))
- :group 'ido)
+ (const :tag "Never" nil)))
(defcustom ido-use-faces t
"Non-nil means use Ido faces to highlighting first match, only match and
subdirs in the alternatives."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defface ido-first-match '((t :weight bold))
- "Face used by Ido for highlighting first match."
- :group 'ido)
+ "Face used by Ido for highlighting first match.")
(defface ido-only-match '((((class color))
:foreground "ForestGreen")
(t :slant italic))
- "Face used by Ido for highlighting only match."
- :group 'ido)
+ "Face used by Ido for highlighting only match.")
(defface ido-subdir '((((min-colors 88) (class color))
:foreground "red1")
(((class color))
:foreground "red")
(t :underline t))
- "Face used by Ido for highlighting subdirs in the alternatives."
- :group 'ido)
+ "Face used by Ido for highlighting subdirs in the alternatives.")
(defface ido-virtual '((t :inherit font-lock-builtin-face))
"Face used by Ido for matching virtual buffer names."
- :version "24.1"
- :group 'ido)
+ :version "24.1")
(defface ido-indicator '((((min-colors 88) (class color))
:foreground "yellow1" :background "red1" :width condensed)
(((class color))
:foreground "yellow" :background "red" :width condensed)
(t :inverse-video t))
- "Face used by Ido for highlighting its indicators."
- :group 'ido)
+ "Face used by Ido for highlighting its indicators.")
(defface ido-incomplete-regexp
'((t :inherit font-lock-warning-face))
- "Ido face for indicating incomplete regexps."
- :group 'ido)
+ "Ido face for indicating incomplete regexps.")
(defcustom ido-make-file-list-hook nil
"List of functions to run when the list of matching files is created.
Each function on the list may modify the dynamically bound variable
`ido-temp-list' which contains the current list of matching files."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defcustom ido-make-dir-list-hook nil
"List of functions to run when the list of matching directories is created.
Each function on the list may modify the dynamically bound variable
`ido-temp-list' which contains the current list of matching directories."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defcustom ido-make-buffer-list-hook nil
"List of functions to run when the list of matching buffers is created.
Each function on the list may modify the dynamically bound variable
`ido-temp-list' which contains the current list of matching buffer names."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defcustom ido-rewrite-file-prompt-functions nil
"List of functions to run when the find-file prompt is created.
@@ -908,8 +848,7 @@ variables:
The following variables are available, but should not be changed:
`ido-current-directory' - the unabbreviated directory name
item - equals `file' or `dir' depending on the current mode."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defvar ido-rewrite-file-prompt-rules nil
"Alist of rewriting rules for directory names in Ido prompts.
@@ -924,14 +863,12 @@ also modify the dynamic variables described for the variable
(defcustom ido-completion-buffer "*Ido Completions*"
"Name of completion buffer used by Ido.
Set to nil to disable completion buffers popping up."
- :type 'string
- :group 'ido)
+ :type 'string)
(defcustom ido-completion-buffer-all-completions nil
"Non-nil means to show all completions in completion buffer.
Otherwise, only the current list of matches is shown."
- :type 'boolean
- :group 'ido)
+ :type 'boolean)
(defcustom ido-all-frames 'visible
"Argument to pass to `walk-windows' when Ido is finding buffers.
@@ -939,8 +876,7 @@ See documentation of `walk-windows' for useful values."
:type '(choice (const :tag "Selected frame only" nil)
(const :tag "All existing frames" t)
(const :tag "All visible frames" visible)
- (const :tag "All frames on this terminal" 0))
- :group 'ido)
+ (const :tag "All frames on this terminal" 0)))
(defcustom ido-minibuffer-setup-hook nil
"Ido-specific customization of minibuffer setup.
@@ -954,8 +890,7 @@ with other packages. For instance:
will constrain Emacs to a maximum minibuffer height of 3 lines when
Ido is running. Copied from `icomplete-minibuffer-setup-hook'."
- :type 'hook
- :group 'ido)
+ :type 'hook)
(defcustom ido-save-directory-list-file
(locate-user-emacs-file "ido.last" ".ido.last")
@@ -964,28 +899,24 @@ Variables stored are: `ido-last-directory-list', `ido-work-directory-list',
`ido-work-file-list', and `ido-dir-file-cache'.
Must be set before enabling Ido mode."
:version "24.4" ; added locate-user-emacs-file
- :type 'string
- :group 'ido)
+ :type 'string)
(defcustom ido-read-file-name-as-directory-commands '()
"List of commands which use `read-file-name' to read a directory name.
When `ido-everywhere' is non-nil, the commands in this list will read
the directory using `ido-read-directory-name'."
- :type '(repeat symbol)
- :group 'ido)
+ :type '(repeat symbol))
(defcustom ido-read-file-name-non-ido '()
"List of commands which shall not read file names the Ido way.
When `ido-everywhere' is non-nil, the commands in this list will read
the file name using normal `read-file-name' style."
- :type '(repeat symbol)
- :group 'ido)
+ :type '(repeat symbol))
(defcustom ido-before-fallback-functions '()
"List of functions to call before calling a fallback command.
The fallback command is passed as an argument to the functions."
- :type 'hook
- :group 'ido)
+ :type 'hook)
;;;; Keymaps
@@ -1071,10 +1002,10 @@ The fallback command is passed as an argument to the functions."
;;;; Persistent variables
-(defvar ido-file-history nil
+(defvar ido-file-history nil
"History of files selected using `ido-find-file'.")
-(defvar ido-buffer-history nil
+(defvar ido-buffer-history nil
"History of buffers selected using `ido-switch-buffer'.")
(defvar ido-last-directory-list nil
@@ -1583,18 +1514,19 @@ Removes badly formatted data and ignored directories."
(ido-save-history))
(defun ido-common-initialization ()
- (add-hook 'minibuffer-setup-hook 'ido-minibuffer-setup)
- (add-hook 'choose-completion-string-functions 'ido-choose-completion-string))
+ (add-hook 'minibuffer-setup-hook #'ido-minibuffer-setup)
+ (add-hook 'choose-completion-string-functions #'ido-choose-completion-string))
(define-minor-mode ido-everywhere
"Toggle use of Ido for all buffer/file reading."
:global t
- :group 'ido
(remove-function read-file-name-function #'ido-read-file-name)
(remove-function read-buffer-function #'ido-read-buffer)
(when ido-everywhere
- (add-function :override read-file-name-function #'ido-read-file-name)
- (add-function :override read-buffer-function #'ido-read-buffer)))
+ (if (not ido-mode)
+ (ido-mode 'both)
+ (add-function :override read-file-name-function #'ido-read-file-name)
+ (add-function :override read-buffer-function #'ido-read-buffer))))
(defvar ido-minor-mode-map-entry nil)
@@ -1619,13 +1551,13 @@ This function also adds a hook to the minibuffer."
((> (prefix-numeric-value arg) 0) 'both)
(t nil)))
- (ido-everywhere (if ido-everywhere 1 -1))
+ (ido-everywhere (if (and ido-mode ido-everywhere) 1 -1))
(when ido-mode
(ido-common-initialization)
(ido-load-history)
- (add-hook 'kill-emacs-hook 'ido-kill-emacs-hook)
+ (add-hook 'kill-emacs-hook #'ido-kill-emacs-hook)
(let ((map (make-sparse-keymap)))
(when (memq ido-mode '(file both))
@@ -2286,7 +2218,10 @@ If cursor is not at the end of the user input, move to end of input."
((and ido-enable-virtual-buffers
ido-virtual-buffers
(setq filename (assoc buf ido-virtual-buffers)))
- (ido-visit-buffer (find-file-noselect (cdr filename)) method t))
+ (if (eq method 'kill)
+ (setq recentf-list
+ (delete (cdr filename) recentf-list))
+ (ido-visit-buffer (find-file-noselect (cdr filename)) method t)))
((and (eq ido-create-new-buffer 'prompt)
(null require-match)
@@ -2445,9 +2380,9 @@ If cursor is not at the end of the user input, move to end of input."
nil ido-text 'ido-enter-insert-file))
((eq ido-exit 'dired)
- (funcall (cond ((eq method 'other-window) 'dired-other-window)
- ((eq method 'other-frame) 'dired-other-frame)
- (t 'dired))
+ (funcall (cond ((eq method 'other-window) #'dired-other-window)
+ ((eq method 'other-frame) #'dired-other-frame)
+ (t #'dired))
(concat ido-current-directory (or ido-text ""))))
((eq ido-exit 'ffap)
@@ -3480,13 +3415,18 @@ instead removed from the current item list."
(defun ido-make-buffer-list-1 (&optional frame visible)
"Return list of non-ignored buffer names."
- (delq nil
- (mapcar
- (lambda (x)
- (let ((name (buffer-name x)))
- (if (not (or (ido-ignore-item-p name ido-ignore-buffers) (member name visible)))
- name)))
- (buffer-list frame))))
+ (with-temp-buffer
+ ;; Each call to ido-ignore-item-p LET-binds case-fold-search.
+ ;; That is slow if there's no buffer-local binding available,
+ ;; roughly O(number of buffers). This hack avoids it.
+ (setq-local case-fold-search nil)
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (let ((name (buffer-name x)))
+ (if (not (or (ido-ignore-item-p name ido-ignore-buffers) (member name visible)))
+ name)))
+ (buffer-list frame)))))
(defun ido-make-buffer-list (default)
"Return the current list of buffers.
@@ -3598,7 +3538,7 @@ it is put to the start of the list."
;; tramp-ftp-file-name-p is available only when tramp
;; has been loaded.
(fboundp 'tramp-ftp-file-name-p)
- (funcall 'tramp-ftp-file-name-p dir)
+ (tramp-ftp-file-name-p dir)
(string-match ":\\'" dir)
(file-name-all-completions "" (concat dir "./"))))))
(if (and compl
@@ -3698,7 +3638,8 @@ in this list."
(not (ido-local-file-exists-p x)))
(and (not (ido-final-slash x))
(let (file-name-handler-alist)
- (get-file-buffer x)))) x))
+ (get-file-buffer x))))
+ x))
ido-temp-list)))))
(ido-to-end ;; move . files to end
(delq nil (mapcar
@@ -3731,7 +3672,8 @@ If MERGED is non-nil, each subdir is cons'ed with DIR."
(delq nil
(mapcar
(lambda (name)
- (and (ido-final-slash name) (not (ido-ignore-item-p name ido-ignore-directories))
+ (and (ido-final-slash name)
+ (not (ido-ignore-item-p name ido-ignore-directories))
(if merged (cons name dir) name)))
(ido-file-name-all-completions dir)))))
@@ -3997,6 +3939,14 @@ If `ido-change-word-sub' cannot be found in WORD, return nil."
(when (bobp)
(next-completion 1)))))
+(defun ido-completion-auto-help ()
+ "Call `ido-completion-help' if `completion-auto-help' is non-nil."
+ (interactive)
+ ;; Note: `completion-auto-help' could also be `lazy', but this value
+ ;; is irrelevant to ido, which is fundamentally eager, so it is
+ ;; treated the same as t.
+ (when completion-auto-help
+ (ido-completion-help)))
(defun ido-completion-help ()
"Show possible completions in the `ido-completion-buffer'."
@@ -4041,7 +3991,7 @@ If `ido-change-word-sub' cannot be found in WORD, return nil."
(t
(copy-sequence (or ido-matches ido-cur-list))))
#'ido-file-lessp)))
- ;;(add-hook 'completion-setup-hook 'completion-setup-function)
+ ;;(add-hook 'completion-setup-hook #'completion-setup-function)
(display-completion-list completion-list))))))
;;; KILL CURRENT BUFFER
@@ -4128,6 +4078,7 @@ Record command in `command-history' if optional RECORD is non-nil."
(setq buffer (buffer-name buffer)))
(let (win newframe)
(cond
+ ;; "Killing" of virtual buffers is handled in `ido-buffer-internal'.
((eq method 'kill)
(if record
(ido-record-command 'kill-buffer buffer))
@@ -4707,7 +4658,9 @@ For details of keybindings, see `ido-find-file'."
(not (input-pending-p)))
(ido-trace "\n*start timer*")
(setq ido-auto-merge-timer
- (run-with-timer ido-auto-merge-delay-time nil 'ido-initiate-auto-merge (current-buffer))))))
+ (run-with-timer ido-auto-merge-delay-time nil
+ #'ido-initiate-auto-merge
+ (current-buffer))))))
(setq ido-rescan t)
@@ -4830,8 +4783,8 @@ Modified from `icomplete-completions'."
"Minibuffer setup hook for Ido."
;; Copied from `icomplete-minibuffer-setup-hook'.
(when (ido-active)
- (add-hook 'pre-command-hook 'ido-tidy nil t)
- (add-hook 'post-command-hook 'ido-exhibit nil t)
+ (add-hook 'pre-command-hook #'ido-tidy nil t)
+ (add-hook 'post-command-hook #'ido-exhibit nil t)
(run-hooks 'ido-minibuffer-setup-hook)
(when ido-initial-position
(goto-char (+ (minibuffer-prompt-end) ido-initial-position))
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 41675c011d8..91d025dd5dd 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -44,8 +44,7 @@
(defcustom ielm-noisy t
"If non-nil, IELM will beep on error."
- :type 'boolean
- :group 'ielm)
+ :type 'boolean)
(defcustom ielm-prompt-read-only t
"If non-nil, the IELM prompt is read only.
@@ -74,7 +73,6 @@ buffers, including IELM buffers. If you sometimes use IELM on
text-only terminals or with `emacs -nw', you might wish to use
another binding for `comint-kill-whole-line'."
:type 'boolean
- :group 'ielm
:version "22.1")
(defcustom ielm-prompt "ELISP> "
@@ -90,8 +88,7 @@ does not update the prompt of an *ielm* buffer with a running process.
For IELM buffers that are not called `*ielm*', you can execute
\\[inferior-emacs-lisp-mode] in that IELM buffer to update the value,
for new prompts. This works even if the buffer has a running process."
- :type 'string
- :group 'ielm)
+ :type 'string)
(defvar ielm-prompt-internal "ELISP> "
"Stored value of `ielm-prompt' in the current IELM buffer.
@@ -103,8 +100,7 @@ customizes `ielm-prompt'.")
"Controls whether \\<ielm-map>\\[ielm-return] has intelligent behavior in IELM.
If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline
and indents for incomplete sexps. If nil, always inserts newlines."
- :type 'boolean
- :group 'ielm)
+ :type 'boolean)
(defcustom ielm-dynamic-multiline-inputs t
"Force multiline inputs to start from column zero?
@@ -112,15 +108,13 @@ If non-nil, after entering the first line of an incomplete sexp, a newline
will be inserted after the prompt, moving the input to the next line.
This gives more frame width for large indented sexps, and allows functions
such as `edebug-defun' to work with such inputs."
- :type 'boolean
- :group 'ielm)
+ :type 'boolean)
(defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook)
(defcustom ielm-mode-hook nil
"Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started."
:options '(eldoc-mode)
- :type 'hook
- :group 'ielm)
+ :type 'hook)
;; We define these symbols (that are only used buffer-locally in ielm
;; buffers) this way to avoid having them be defined in the global
@@ -366,9 +360,9 @@ nonempty, then flushes the buffer."
;; that same let. To avoid problems, neither of
;; these buffers should be alive during the
;; evaluation of form.
- (let* ((*1 *)
- (*2 **)
- (*3 ***)
+ (let* ((*1 (bound-and-true-p *))
+ (*2 (bound-and-true-p **))
+ (*3 (bound-and-true-p ***))
(active-process (ielm-process))
(old-standard-output standard-output)
new-standard-output
@@ -453,11 +447,12 @@ nonempty, then flushes the buffer."
(if error-type
(progn
(when ielm-noisy (ding))
- (setq output (concat output "*** " error-type " *** "))
- (setq output (concat output result)))
+ (setq output (concat output
+ "*** " error-type " *** "
+ result)))
;; There was no error, so shift the *** values
- (setq *** **)
- (setq ** *)
+ (setq *** (bound-and-true-p **))
+ (setq ** (bound-and-true-p *))
(setq * result))
(when (or (not for-effect) (not (equal output "")))
(setq output (concat output "\n"))))
@@ -538,11 +533,14 @@ Customized bindings may be defined in `ielm-map', which currently contains:
(set (make-local-variable 'paragraph-start) comint-prompt-regexp)
(setq comint-input-sender 'ielm-input-sender)
(setq comint-process-echoes nil)
- (set (make-local-variable 'completion-at-point-functions)
- '(comint-replace-by-expanded-history
- ielm-complete-filename elisp-completion-at-point))
- (add-function :before-until (local 'eldoc-documentation-function)
- #'elisp-eldoc-documentation-function)
+ (dolist (f '(elisp-completion-at-point
+ ielm-complete-filename
+ comint-replace-by-expanded-history))
+ (add-hook 'completion-at-point-functions f nil t))
+ (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-var-docstring nil t)
+ (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-funcall nil t)
(set (make-local-variable 'ielm-prompt-internal) ielm-prompt)
(set (make-local-variable 'comint-prompt-read-only) ielm-prompt-read-only)
(setq comint-get-old-input 'ielm-get-old-input)
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 8025060b0ea..a29adde8325 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -60,7 +60,7 @@
;; =============
;;
;; * The ImageMagick package. Currently, `convert' and `mogrify' are
-;; used. Find it here: http://www.imagemagick.org.
+;; used. Find it here: https://www.imagemagick.org.
;;
;; * For non-lossy rotation of JPEG images, the JpegTRAN program is
;; needed.
@@ -149,7 +149,6 @@
;;; Code:
(require 'dired)
-(require 'format-spec)
(require 'image-mode)
(require 'widget)
@@ -206,7 +205,7 @@ the index.html page that image-dired creates."
:group 'image-dired)
(defcustom image-dired-gallery-image-root-url
-"http://your.own.server/image-diredpics"
+"https://your.own.server/image-diredpics"
"URL where the full size images are to be found.
Note that this path has to be configured in your web server. Image-Dired
expects to find pictures in this directory."
@@ -214,7 +213,7 @@ expects to find pictures in this directory."
:group 'image-dired)
(defcustom image-dired-gallery-thumb-image-root-url
-"http://your.own.server/image-diredthumbs"
+"https://your.own.server/image-diredthumbs"
"URL where the thumbnail images are to be found.
Note that this path has to be configured in your web server. Image-Dired
expects to find pictures in this directory."
@@ -771,8 +770,8 @@ Increase at own risk.")
process)
(when (not (file-exists-p thumbnail-dir))
(message "Creating thumbnail directory")
- (make-directory thumbnail-dir t)
- (set-file-modes thumbnail-dir #o700))
+ (with-file-modes #o700
+ (make-directory thumbnail-dir t)))
;; Thumbnail file creation processes begin here and are marshaled
;; in a queue by `image-dired-create-thumb'.
diff --git a/lisp/image-file.el b/lisp/image-file.el
index 89cd75d50dd..3b4f5722518 100644
--- a/lisp/image-file.el
+++ b/lisp/image-file.el
@@ -1,4 +1,4 @@
-;;; image-file.el --- support for visiting image files
+;;; image-file.el --- support for visiting image files -*- lexical-binding:t -*-
;;
;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
;;
@@ -32,6 +32,7 @@
;;; Code:
(require 'image)
+(require 'image-converter)
;;;###autoload
@@ -80,13 +81,16 @@ the variable is set using \\[customize]."
(let ((exts-regexp
(and image-file-name-extensions
(concat "\\."
- (regexp-opt (nconc (mapcar #'upcase
- image-file-name-extensions)
- image-file-name-extensions)
- t)
+ (regexp-opt
+ (append (mapcar #'upcase image-file-name-extensions)
+ image-file-name-extensions
+ (mapcar #'upcase
+ image-converter-file-name-extensions)
+ image-converter-file-name-extensions)
+ t)
"\\'"))))
(mapconcat
- 'identity
+ #'identity
(delq nil (list exts-regexp
image-file-name-regexps
(car (rassq 'imagemagick image-type-file-name-regexps))))
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 1bb213c2489..032ebf38733 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -40,6 +40,7 @@
(require 'image)
(require 'exif)
+(require 'dired)
(eval-when-compile (require 'cl-lib))
;;; Image mode window-info management.
@@ -611,24 +612,35 @@ Key bindings:
(setq major-mode 'image-mode)
(setq image-transform-resize image-auto-resize)
+ ;; Bail out early if we have no image data.
+ (if (zerop (buffer-size))
+ (funcall (if (called-interactively-p 'any) 'error 'message)
+ (if (file-exists-p buffer-file-name)
+ "Empty file"
+ "(New file)"))
+ (image-mode--display)))
+
+(defun image-mode--display ()
(if (not (image-get-display-property))
(progn
(when (condition-case err
- (progn
- (image-toggle-display-image)
- t)
- (unknown-image-type
- (image-mode-as-text)
- (funcall
- (if (called-interactively-p 'any) 'error 'message)
- "Unknown image type; consider switching `image-use-external-converter' on")
- nil)
- (error
- (image-mode-as-text)
- (funcall
- (if (called-interactively-p 'any) 'error 'message)
- "Cannot display image: %s" (cdr err))
- nil))
+ (progn
+ (image-toggle-display-image)
+ t)
+ (unknown-image-type
+ (image-mode-as-text)
+ (funcall
+ (if (called-interactively-p 'any) 'error 'message)
+ (if image-use-external-converter
+ "Unknown image type"
+ "Unknown image type; consider switching `image-use-external-converter' on"))
+ nil)
+ (error
+ (image-mode-as-text)
+ (funcall
+ (if (called-interactively-p 'any) 'error 'message)
+ "Cannot display image: %s" (cdr err))
+ nil))
;; If attempt to display the image fails.
(if (not (image-get-display-property))
(error "Invalid image"))
@@ -706,7 +718,7 @@ A non-mage major mode found from `auto-mode-alist' or fundamental mode
displays an image file as text."
;; image-mode-as-text = normal-mode + image-minor-mode
(let ((previous-image-type image-type)) ; preserve `image-type'
- (major-mode-restore '(image-mode image-mode-maybe image-mode-as-text))
+ (major-mode-restore '(image-mode image-mode-as-text))
;; Restore `image-type' after `kill-all-local-variables' in `normal-mode'.
(setq image-type previous-image-type)
;; Enable image minor mode with `C-c C-c'.
@@ -756,8 +768,6 @@ on these modes."
(if (image-get-display-property)
"text" "an image or hex") ".")))
-(define-obsolete-function-alias 'image-mode-maybe 'image-mode "23.2")
-
(defun image-toggle-display-text ()
"Show the image file as text.
Remove text properties that display the image."
@@ -816,13 +826,21 @@ was inserted."
(- (nth 2 edges) (nth 0 edges))))
(max-height (when edges
(- (nth 3 edges) (nth 1 edges))))
- (type (if (image--imagemagick-wanted-p filename)
- 'imagemagick
- (image-type file-or-data nil data-p)))
(inhibit-read-only t)
(buffer-undo-list t)
(modified (buffer-modified-p))
- props image)
+ props image type)
+
+ ;; If the data in the current buffer isn't from an existing file,
+ ;; but we have a file name (this happens when visiting images from
+ ;; a zip file, for instance), provide a type hint based on the
+ ;; suffix.
+ (when (and data-p filename)
+ (setq data-p (intern (format "image/%s"
+ (file-name-extension filename)))))
+ (setq type (if (image--imagemagick-wanted-p filename)
+ 'imagemagick
+ (image-type file-or-data nil data-p)))
;; Get the rotation data from the file, if any.
(when (zerop image-transform-rotation) ; don't reset modified value
@@ -839,10 +857,13 @@ was inserted."
;; :scale 1: If we do not set this, create-image will apply
;; default scaling based on font size.
(setq image (if (not edges)
- (create-image file-or-data type data-p :scale 1)
+ (create-image file-or-data type data-p :scale 1
+ :format (and filename data-p))
(create-image file-or-data type data-p :scale 1
:max-width max-width
- :max-height max-height)))
+ :max-height max-height
+ ;; Type hint.
+ :format (and filename data-p))))
;; Discard any stale image data before looking it up again.
(image-flush image)
@@ -1072,28 +1093,87 @@ replacing the current Image mode buffer."
(error "The buffer is not in Image mode"))
(unless buffer-file-name
(error "The current image is not associated with a file"))
- (let* ((file (file-name-nondirectory buffer-file-name))
- (images (image-mode--images-in-directory file))
- (idx 0))
- (catch 'image-visit-next-file
- (dolist (f images)
- (if (string= f file)
- (throw 'image-visit-next-file (1+ idx)))
- (setq idx (1+ idx))))
- (setq idx (mod (+ idx (or n 1)) (length images)))
- (let ((image (nth idx images))
- (dir (file-name-directory buffer-file-name)))
- (find-alternate-file image)
- ;; If we have dired buffer(s) open to where this image is, then
- ;; place point on it.
+ (let ((next (image-mode--next-file buffer-file-name n)))
+ (unless next
+ (user-error "No %s file in this directory"
+ (if (> n 0)
+ "next"
+ "prev")))
+ (if (stringp next)
+ (find-alternate-file next)
+ (funcall next))))
+
+(defun image-mode--directory-buffers (file)
+ "Return a alist of type/buffer for all \"parent\" buffers to image FILE.
+This is normally a list of dired buffers, but can also be archive and
+tar mode buffers."
+ (let ((buffers nil)
+ (dir (file-name-directory file)))
+ (cond
+ ((and (boundp 'tar-superior-buffer)
+ tar-superior-buffer)
+ (when (buffer-live-p tar-superior-buffer)
+ (push (cons 'tar tar-superior-buffer) buffers)))
+ ((and (boundp 'archive-superior-buffer)
+ archive-superior-buffer)
+ (when (buffer-live-p archive-superior-buffer)
+ (push (cons 'archive archive-superior-buffer) buffers)))
+ (t
+ ;; Find a dired buffer.
(dolist (buffer (buffer-list))
- (with-current-buffer buffer
- (when (and (derived-mode-p 'dired-mode)
+ (with-current-buffer buffer
+ (when (and (derived-mode-p 'dired-mode)
(equal (file-truename dir)
(file-truename default-directory)))
- (save-window-excursion
- (switch-to-buffer (current-buffer) t t)
- (dired-goto-file (expand-file-name image dir)))))))))
+ (push (cons 'dired (current-buffer)) buffers))))
+ ;; If we can't find any buffers to navigate in, we open a dired
+ ;; buffer.
+ (unless buffers
+ (push (cons 'dired (find-file-noselect dir)) buffers)
+ (message "Opened a dired buffer on %s" dir))))
+ buffers))
+
+(declare-function archive-next-file-displayer "arc-mode")
+(declare-function tar-next-file-displayer "tar-mode")
+
+(defun image-mode--next-file (file n)
+ "Go to the next image file in the parent buffer of FILE.
+This is typically a dired buffer, but may also be a tar/archive buffer.
+Return the next image file from that buffer.
+If N is negative, go to the previous file."
+ (let ((regexp (image-file-name-regexp))
+ (buffers (image-mode--directory-buffers file))
+ next)
+ (dolist (buffer buffers)
+ ;; We do this traversal for all the dired buffers open on this
+ ;; directory. There probably is just one, but we want to move
+ ;; point in all of them.
+ (save-window-excursion
+ (switch-to-buffer (cdr buffer) t t)
+ (cl-case (car buffer)
+ ('dired
+ (dired-goto-file file)
+ (let (found)
+ (while (and (not found)
+ ;; Stop if we reach the end/start of the buffer.
+ (if (> n 0)
+ (not (eobp))
+ (not (bobp))))
+ (dired-next-line n)
+ (let ((candidate (dired-get-filename nil t)))
+ (when (and candidate
+ (string-match-p regexp candidate))
+ (setq found candidate))))
+ (if found
+ (setq next found)
+ ;; If we didn't find a next/prev file, then restore
+ ;; point.
+ (dired-goto-file file))))
+ ('archive
+ (setq next (archive-next-file-displayer file regexp n)))
+ ('tar
+ (setq next (tar-next-file-displayer file regexp n))))))
+ next))
(defun image-previous-file (&optional n)
"Visit the preceding image in the same directory as the current file.
diff --git a/lisp/image.el b/lisp/image.el
index 963991d6418..9ebb603086e 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -784,6 +784,7 @@ number, play until that number of seconds has elapsed."
(if (setq timer (image-animate-timer image))
(cancel-timer timer))
(plist-put (cdr image) :animate-buffer (current-buffer))
+ (plist-put (cdr image) :animate-tardiness 0)
(run-with-timer 0.2 nil #'image-animate-timeout
image (or index 0) (car animation)
0 limit (+ (float-time) 0.2)))))
@@ -848,9 +849,14 @@ The minimum delay between successive frames is `image-minimum-frame-delay'.
If the image has a non-nil :speed property, it acts as a multiplier
for the animation speed. A negative value means to animate in reverse."
+ ;; We keep track of "how late" image frames arrive. We decay the
+ ;; previous cumulative value by 10% and then add the current delay.
+ (plist-put (cdr image) :animate-tardiness
+ (+ (* (plist-get (cdr image) :animate-tardiness) 0.9)
+ (float-time (time-since target-time))))
(when (and (buffer-live-p (plist-get (cdr image) :animate-buffer))
- ;; Delayed more than two seconds more than expected.
- (or (time-less-p (time-since target-time) 2)
+ ;; Cumulatively delayed two seconds more than expected.
+ (or (< (plist-get (cdr image) :animate-tardiness) 2)
(progn
(message "Stopping animation; animation possibly too big")
nil)))
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index b8542bc3c35..3543be6de91 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -26,6 +26,7 @@
(require 'url)
(require 'url-cache)
+(require 'dns)
(eval-when-compile
(require 'subr-x))
@@ -38,6 +39,7 @@
"Whether to cache retrieved gravatars."
:type 'boolean
:group 'gravatar)
+(make-obsolete-variable 'gravatar-automatic-caching nil "28.1")
(defcustom gravatar-cache-ttl 2592000
"Time to live in seconds for gravatar cache entries.
@@ -47,6 +49,7 @@ is retrieved anew. The default value is 30 days."
;; Restricted :type to number of seconds.
:version "27.1"
:group 'gravatar)
+(make-obsolete-variable 'gravatar-cache-ttl nil "28.1")
(defcustom gravatar-rating "g"
"Most explicit Gravatar rating level to allow.
@@ -118,9 +121,95 @@ a gravatar for a given email address."
:version "27.1"
:group 'gravatar)
-(defconst gravatar-base-url
- "https://www.gravatar.com/avatar"
- "Base URL for getting gravatars.")
+(defconst gravatar-service-alist
+ `((gravatar . ,(lambda (_addr callback)
+ (funcall callback "https://www.gravatar.com/avatar")))
+ (unicornify . ,(lambda (_addr callback)
+ (funcall callback "https://unicornify.pictures/avatar/")))
+ (libravatar . ,#'gravatar--service-libravatar))
+ "Alist of supported gravatar services.")
+
+(defcustom gravatar-service 'gravatar
+ "Symbol denoting gravatar-like service to use.
+Note that certain services might ignore other options, such as
+`gravatar-default-image' or certain values as with
+`gravatar-rating'.
+
+Note that `'libravatar' has security implications: It can be used
+to track whether you're reading a specific mail."
+ :type `(choice ,@(mapcar (lambda (s) `(const ,(car s)))
+ gravatar-service-alist))
+ :version "28.1"
+ :link '(url-link "https://www.libravatar.org/")
+ :link '(url-link "https://unicornify.pictures/")
+ :link '(url-link "https://gravatar.com/")
+ :group 'gravatar)
+
+(defun gravatar--service-libravatar (addr callback)
+ "Find domain that hosts avatars for email address ADDR."
+ ;; implements https://wiki.libravatar.org/api/
+ (save-match-data
+ (if (not (string-match ".+@\\(.+\\)" addr))
+ (funcall callback "https://seccdn.libravatar.org/avatar")
+ (let ((domain (match-string 1 addr))
+ (records '(("_avatars-sec" . "https")
+ ("_avatars" . "http")))
+ func)
+ (setq func
+ (lambda (result)
+ (cond
+ ((and
+ result ;there is a result
+ (let* ((data (mapcar (lambda (record)
+ (dns-get 'data (cdr record)))
+ (dns-get 'answers result)))
+ (priorities (mapcar (lambda (r)
+ (dns-get 'priority r))
+ data))
+ (max-priority (if priorities
+ (apply #'max priorities)
+ 0))
+ (sum 0) top)
+ ;; Attempt to find all records with the same maximal
+ ;; priority, and calculate the sum of their weights.
+ (dolist (ent data)
+ (when (= max-priority (dns-get 'priority ent))
+ (setq sum (+ sum (dns-get 'weight ent)))
+ (push ent top)))
+ ;; In case there is more than one maximal priority
+ ;; record, choose one at random, while taking the
+ ;; individual record weights into consideration.
+ (catch 'done
+ (dolist (ent top)
+ (when (and (or (= 0 sum)
+ (<= 0 (random sum)
+ (dns-get 'weight ent)))
+ ;; Ensure that port and domain data are
+ ;; valid. In case non of the results
+ ;; were valid, `catch' will evaluate to
+ ;; nil, and the next cond clause will be
+ ;; tested.
+ (<= 1 (dns-get 'port ent) 65535)
+ (string-match-p "\\`[-.0-9A-Za-z]+\\'"
+ (dns-get 'target ent)))
+ (funcall callback
+ (url-normalize-url
+ (format "%s://%s:%s/avatar"
+ (cdar records)
+ (dns-get 'target ent)
+ (dns-get 'port ent))))
+ (throw 'done t))
+ (setq sum (- sum (dns-get 'weight ent))))))))
+ ((setq records (cdr records))
+ ;; In case there are at least two methods.
+ (dns-query-asynchronous
+ (concat (caar records) "._tcp." domain)
+ func 'SRV))
+ (t ;fallback
+ (funcall callback "https://seccdn.libravatar.org/avatar")))))
+ (dns-query-asynchronous
+ (concat (caar records) "._tcp." domain)
+ func 'SRV t)))))
(defun gravatar-hash (mail-address)
"Return the Gravatar hash for MAIL-ADDRESS."
@@ -138,13 +227,18 @@ a gravatar for a given email address."
,@(and gravatar-size
`((s ,gravatar-size))))))
-(defun gravatar-build-url (mail-address)
- "Return the URL of a gravatar for MAIL-ADDRESS."
+(defun gravatar-build-url (mail-address callback)
+ "Find the URL of a gravatar for MAIL-ADDRESS and call CALLBACK with it."
;; https://gravatar.com/site/implement/images/
- (format "%s/%s?%s"
- gravatar-base-url
- (gravatar-hash mail-address)
- (gravatar--query-string)))
+ (let ((query-string (gravatar--query-string)))
+ (funcall (alist-get gravatar-service gravatar-service-alist)
+ mail-address
+ (lambda (url)
+ (funcall callback
+ (format "%s/%s?%s"
+ url
+ (gravatar-hash mail-address)
+ query-string))))))
(defun gravatar-get-data ()
"Return body of current URL buffer, or nil on failure."
@@ -154,28 +248,62 @@ a gravatar for a given email address."
(search-forward "\n\n" nil t)
(buffer-substring (point) (point-max)))))
+(defvar gravatar--cache (make-hash-table :test 'equal)
+ "Cache for gravatars.")
+
;;;###autoload
(defun gravatar-retrieve (mail-address callback &optional cbargs)
"Asynchronously retrieve a gravatar for MAIL-ADDRESS.
When finished, call CALLBACK as (apply CALLBACK GRAVATAR CBARGS),
where GRAVATAR is either an image descriptor, or the symbol
`error' if the retrieval failed."
- (let ((url (gravatar-build-url mail-address)))
- (if (url-cache-expired url gravatar-cache-ttl)
- (url-retrieve url #'gravatar-retrieved (list callback cbargs) t)
- (with-current-buffer (url-fetch-from-cache url)
- (gravatar-retrieved () callback cbargs)))))
+ (let ((cached (gethash mail-address gravatar--cache)))
+ (gravatar--prune-cache)
+ (if cached
+ (apply callback (cdr cached) cbargs)
+ ;; Nothing in the cache, fetch it.
+ (gravatar-build-url
+ mail-address
+ (lambda (url)
+ (url-retrieve
+ url
+ (lambda (status)
+ (let* ((data (and (not (plist-get status :error))
+ (gravatar-get-data)))
+ (image (and data (create-image data nil t))))
+ ;; Store the image in the cache.
+ (when image
+ (setf (gethash mail-address gravatar--cache)
+ (cons (time-convert (current-time) 'integer)
+ image)))
+ (prog1
+ (apply callback (if data image 'error) cbargs)
+ (kill-buffer))))
+ nil t))))))
+
+(defun gravatar--prune-cache ()
+ (let ((expired nil)
+ (time (- (time-convert (current-time) 'integer)
+ ;; Twelve hours.
+ (* 12 60 60))))
+ (maphash (lambda (key val)
+ (when (< (car val) time)
+ (push key expired)))
+ gravatar--cache)
+ (dolist (key expired)
+ (remhash key gravatar--cache))))
;;;###autoload
(defun gravatar-retrieve-synchronously (mail-address)
"Synchronously retrieve a gravatar for MAIL-ADDRESS.
Value is either an image descriptor, or the symbol `error' if the
retrieval failed."
- (let ((url (gravatar-build-url mail-address)))
- (with-current-buffer (if (url-cache-expired url gravatar-cache-ttl)
- (url-retrieve-synchronously url t)
- (url-fetch-from-cache url))
- (gravatar-retrieved () #'identity))))
+ (let ((url nil))
+ (gravatar-build-url mail-address (lambda (u) (setq url u)))
+ (while (not url)
+ (sleep-for 0.01))
+ (with-current-buffer (url-retrieve-synchronously url t)
+ (gravatar-retrieved nil #'identity))))
(defun gravatar-retrieved (status cb &optional cbargs)
"Handle Gravatar response data in current buffer.
@@ -184,10 +312,6 @@ an image descriptor, or the symbol `error' on failure.
This function is intended as a callback for `url-retrieve'."
(let ((data (unless (plist-get status :error)
(gravatar-get-data))))
- (and data ; Only cache on success.
- url-current-object ; Only cache if not already cached.
- gravatar-automatic-caching
- (url-store-in-cache))
(prog1 (apply cb (if data (create-image data nil t) 'error) cbargs)
(kill-buffer))))
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index b694052f5b9..c31a3b8d3cf 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -33,8 +33,15 @@
"Type of the external image converter to use.
The value should a symbol, either `imagemagick', `graphicsmagick',
or `ffmpeg'.
+
If nil, Emacs will try to find one of the supported converters
-installed on the system."
+installed on the system.
+
+The actual range of image formats that will be converted depends
+on what image formats the chosen converter reports being able to
+handle. `auto-mode-alist' is then used to further filter what
+formats that are to be supported: Only the suffixes that map to
+`image-mode' will be handled."
:group 'image
:type 'symbol
:version "27.1")
@@ -42,6 +49,9 @@ installed on the system."
(defvar image-converter-regexp nil
"A regexp that matches the file name suffixes that can be converted.")
+(defvar image-converter-file-name-extensions nil
+ "A list of file name suffixes that can be converted.")
+
(defvar image-converter--converters
'((graphicsmagick :command ("gm" "convert") :probe ("-list" "format"))
(ffmpeg :command "ffmpeg" :probe "-decoders")
@@ -58,9 +68,11 @@ is a string, it should be a MIME format string like
(unless image-converter
(image-converter--find-converter))
;; When image-converter was customized
- (if (and image-converter (not image-converter-regexp))
- (when-let ((formats (image-converter--probe image-converter)))
- (setq image-converter-regexp (concat "\\." (regexp-opt formats) "\\'"))))
+ (when (and image-converter (not image-converter-regexp))
+ (when-let ((formats (image-converter--probe image-converter)))
+ (setq image-converter-regexp
+ (concat "\\." (regexp-opt formats) "\\'"))
+ (setq image-converter-file-name-extensions formats)))
(and image-converter
(or (and (not data-p)
(string-match image-converter-regexp source))
@@ -181,11 +193,25 @@ data is returned as a string."
"Find an installed image converter."
(catch 'done
(dolist (elem image-converter--converters)
- (when-let ((formats (image-converter--probe (car elem))))
+ (when-let ((formats (image-converter--filter-formats
+ (image-converter--probe (car elem)))))
(setq image-converter (car elem)
- image-converter-regexp (concat "\\." (regexp-opt formats) "\\'"))
+ image-converter-regexp (concat "\\." (regexp-opt formats) "\\'")
+ image-converter-file-name-extensions formats)
(throw 'done image-converter)))))
+(defun image-converter--filter-formats (suffixes)
+ "Filter SUFFIXES based on `auto-mode-alist'.
+Only suffixes that map to `image-mode' are returned."
+ (cl-loop with case-fold-search = (if (not auto-mode-case-fold)
+ nil
+ t)
+ for suffix in suffixes
+ when (eq (cdr (assoc (concat "foo." suffix) auto-mode-alist
+ #'string-match))
+ 'image-mode)
+ collect suffix))
+
(cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source
image-format)
"Convert using GraphicsMagick."
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 1949f2f48f7..8fdacb0214d 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -316,28 +316,6 @@ PREVPOS is the variable in which we store the last position displayed."
)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Some examples of functions utilizing the framework of this
-;;;; package.
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; FIXME: This was the only imenu-example-* definition actually used,
-;; by cperl-mode.el. Now cperl-mode has its own copy, so these can
-;; all be removed.
-(defun imenu-example--name-and-position ()
- "Return the current/previous sexp and its (beginning) location.
-Don't move point."
- (declare (obsolete "use your own function instead." "23.2"))
- (save-excursion
- (forward-sexp -1)
- ;; [ydi] modified for imenu-use-markers
- (let ((beg (if imenu-use-markers (point-marker) (point)))
- (end (progn (forward-sexp) (point))))
- (cons (buffer-substring beg end)
- beg))))
-
;;;
;;; Lisp
;;;
@@ -787,10 +765,13 @@ Return one of the entries in index-alist or nil."
index-alist))))
(when (stringp name)
(setq name (or (imenu-find-default name prepared-index-alist) name)))
- (cond (prompt)
- ((and name (imenu--in-alist name prepared-index-alist))
- (setq prompt (format "Index item (default %s): " name)))
- (t (setq prompt "Index item: ")))
+ (unless prompt
+ (setq prompt (format-prompt
+ "Index item"
+ (and name
+ (imenu--in-alist name prepared-index-alist)
+ ;; Default to `name' if it's in the alist.
+ name))))
(let ((minibuffer-setup-hook minibuffer-setup-hook))
;; Display the completion buffer.
(if (not imenu-eager-completion-buffer)
diff --git a/lisp/indent.el b/lisp/indent.el
index 0a0dd99ce08..e67109ab431 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -52,6 +52,8 @@ or in the line's indentation, otherwise it inserts a \"real\" TAB character.
If `complete', TAB first tries to indent the current line, and if the line
was already indented, then try to complete the thing at point.
+Also see `tab-first-completion'.
+
Some programming language modes have their own variable to control this,
e.g., `c-tab-always-indent', and do not respect this variable."
:group 'indent
@@ -60,6 +62,27 @@ e.g., `c-tab-always-indent', and do not respect this variable."
(const :tag "Indent if inside indentation, else TAB" nil)
(const :tag "Indent, or if already indented complete" complete)))
+(defcustom tab-first-completion nil
+ "Governs the behavior of TAB completion on the first press of the key.
+When nil, complete. When `eol', only complete if point is at the
+end of a line. When `word', complete unless the next character
+has word syntax (according to `syntax-after'). When
+`word-or-paren', complete unless the next character is part of a
+word or a parenthesis. When `word-or-paren-or-punct', complete
+unless the next character is part of a word, parenthesis, or
+punctuation. Typing TAB a second time always results in
+completion.
+
+This variable has no effect unless `tab-always-indent' is `complete'."
+ :group 'indent
+ :type '(choice
+ (const :tag "Always complete" nil)
+ (const :tag "Unless at the end of a line" 'eol)
+ (const :tag "Unless looking at a word" 'word)
+ (const :tag "Unless at a word or parenthesis" 'word-or-paren)
+ (const :tag "Unless at a word, parenthesis, or punctuation." 'word-or-paren-or-punct))
+ :version "27.1")
+
(defun indent-according-to-mode ()
"Indent line in proper way for current major mode.
@@ -113,7 +136,7 @@ or performs symbol completion, depending on `tab-always-indent'.
The function called to actually indent the line or insert a tab
is given by the variable `indent-line-function'.
-If a prefix argument is given, after this function indents the
+If a prefix argument is given (ARG), after this function indents the
current line or inserts a tab, it also rigidly indents the entire
balanced expression which starts at the beginning of the current
line, to reflect the current line's indentation.
@@ -141,7 +164,8 @@ prefix argument is ignored."
(t
(let ((old-tick (buffer-chars-modified-tick))
(old-point (point))
- (old-indent (current-indentation)))
+ (old-indent (current-indentation))
+ (syn `(,(syntax-after (point)))))
;; Indent the line.
(or (not (eq (indent--funcall-widened indent-line-function) 'noindent))
@@ -154,7 +178,20 @@ prefix argument is ignored."
;; If the text was already indented right, try completion.
((and (eq tab-always-indent 'complete)
(eq old-point (point))
- (eq old-tick (buffer-chars-modified-tick)))
+ (eq old-tick (buffer-chars-modified-tick))
+ (or (null tab-first-completion)
+ (eq last-command this-command)
+ (and (equal tab-first-completion 'eol)
+ (eolp))
+ (and (member tab-first-completion
+ '(word word-or-paren word-or-paren-or-punct))
+ (not (member 2 syn)))
+ (and (member tab-first-completion
+ '(word-or-paren word-or-paren-or-punct))
+ (not (or (member 4 syn)
+ (member 5 syn))))
+ (and (equal tab-first-completion 'word-or-paren-or-punct)
+ (not (member 1 syn)))))
(completion-at-point))
;; If a prefix argument was given, rigidly indent the following
@@ -212,7 +249,8 @@ It is activated by calling `indent-rigidly' interactively.")
If called interactively with no prefix argument, activate a
transient mode in which the indentation can be adjusted interactively
by typing \\<indent-rigidly-map>\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop].
-Typing any other key deactivates the transient mode.
+Typing any other key exits this mode. If `transient-mark-mode' is enabled,
+exiting also deactivates the mark.
If called from a program, or interactively with prefix ARG,
indent all lines starting in the region forward by ARG columns.
diff --git a/lisp/info-look.el b/lisp/info-look.el
index fb3237efbb1..bcc2930ffc0 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -75,7 +75,7 @@ List elements are cons cells of the form
If a file name matches REGEXP, then use help mode MODE instead of the
buffer's major mode."
- :group 'info-lookup :type '(repeat (cons (string :tag "Regexp")
+ :group 'info-lookup :type '(repeat (cons (regexp :tag "Regexp")
(symbol :tag "Mode"))))
(defvar info-lookup-history nil
@@ -297,9 +297,7 @@ If optional argument QUERY is non-nil, query for the help mode."
(completion-ignore-case (info-lookup->ignore-case topic mode))
(enable-recursive-minibuffers t)
(value (completing-read
- (if default
- (format "Describe %s (default %s): " topic default)
- (format "Describe %s: " topic))
+ (format-prompt "Describe %s" default topic)
completions nil nil nil 'info-lookup-history default)))
(list (if (equal value "") default value) mode)))
@@ -557,7 +555,7 @@ Return nil if there is nothing appropriate in the buffer near point."
(info-lookup->regexp topic mode)))
(start (point)) end regexp subexp result)
(save-excursion
- (if (symbolp rule)
+ (if (functionp rule)
(setq result (funcall rule))
(if (consp rule)
(setq regexp (car rule)
@@ -610,6 +608,7 @@ Return nil if there is nothing appropriate in the buffer near point."
(defun info-lookup-guess-custom-symbol ()
"Get symbol at point in custom buffers."
+ (declare (obsolete nil "28.1"))
(condition-case nil
(save-excursion
(let ((case-fold-search t)
@@ -1065,7 +1064,9 @@ Return nil if there is nothing appropriate in the buffer near point."
:mode 'Custom-mode
:ignore-case t
:regexp "[^][()`'‘’,:\" \t\n]+"
- :parse-rule 'info-lookup-guess-custom-symbol
+ :parse-rule (lambda ()
+ (when-let ((symbol (get-text-property (point) 'custom-data)))
+ (symbol-name symbol)))
:other-modes '(emacs-lisp-mode))
(info-lookup-maybe-add-help
diff --git a/lisp/info.el b/lisp/info.el
index 13c57bdcd13..c3684deb96b 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -67,7 +67,6 @@ Intermediate Info nodes are nodes visited by Info internally in the process of
searching the node to display. Intermediate nodes are not presented
to the user."
:type 'boolean
- :group 'info
:version "24.1")
(defvar Info-enable-active-nodes nil
@@ -79,8 +78,7 @@ The Lisp code is executed when the node is selected.")
'((((class color) (background light)) :foreground "brown" :weight bold :slant italic)
(((class color) (background dark)) :foreground "white" :weight bold :slant italic)
(t :weight bold :slant italic))
- "Face for Info node names."
- :group 'info)
+ "Face for Info node names.")
(defface info-title-1
'((((type tty pc) (class color) (background light))
@@ -88,26 +86,22 @@ The Lisp code is executed when the node is selected.")
(((type tty pc) (class color) (background dark))
:foreground "yellow" :weight bold)
(t :height 1.2 :inherit info-title-2))
- "Face for info titles at level 1."
- :group 'info)
+ "Face for info titles at level 1.")
(defface info-title-2
'((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
(t :height 1.2 :inherit info-title-3))
- "Face for info titles at level 2."
- :group 'info)
+ "Face for info titles at level 2.")
(defface info-title-3
'((((type tty pc) (class color)) :weight bold)
(t :height 1.2 :inherit info-title-4))
- "Face for info titles at level 3."
- :group 'info)
+ "Face for info titles at level 3.")
(defface info-title-4
'((((type tty pc) (class color)) :weight bold)
(t :weight bold :inherit variable-pitch))
- "Face for info titles at level 4."
- :group 'info)
+ "Face for info titles at level 4.")
(defface info-menu-header
'((((type tty pc))
@@ -116,31 +110,26 @@ The Lisp code is executed when the node is selected.")
(t
:inherit variable-pitch
:weight bold))
- "Face for headers in Info menus."
- :group 'info)
+ "Face for headers in Info menus.")
(defface info-menu-star
'((((class color)) :foreground "red1")
(t :underline t))
- "Face for every third `*' in an Info menu."
- :group 'info)
+ "Face for every third `*' in an Info menu.")
(defface info-xref
'((t :inherit link))
- "Face for unvisited Info cross-references."
- :group 'info)
+ "Face for unvisited Info cross-references.")
(defface info-xref-visited
'((t :inherit (link-visited info-xref)))
"Face for visited Info cross-references."
- :version "22.1"
- :group 'info)
+ :version "22.1")
(defcustom Info-fontify-visited-nodes t
"Non-nil to fontify references to visited nodes in `info-xref-visited' face."
:version "22.1"
- :type 'boolean
- :group 'info)
+ :type 'boolean)
;; It's unfortunate that nil means no fontification, as opposed to no limit,
;; since that differs from font-lock-maximum-size.
@@ -150,29 +139,24 @@ Set to nil to disable node fontification; set to t for no limit."
:type '(choice (const :tag "No fontification" nil)
(const :tag "No size limit" t)
(integer :tag "Up to this many characters"))
- :version "25.1" ; 100k -> 400k
- :group 'info)
+ :version "25.1") ; 100k -> 400k
(defcustom Info-use-header-line t
"Non-nil means to put the beginning-of-node links in an Emacs header-line.
A header-line does not scroll with the rest of the buffer."
- :type 'boolean
- :group 'info)
+ :type 'boolean)
(defface info-header-xref
'((t :inherit info-xref))
- "Face for Info cross-references in a node header."
- :group 'info)
+ "Face for Info cross-references in a node header.")
(defface info-header-node
'((t :inherit info-node))
- "Face for Info nodes in a node header."
- :group 'info)
+ "Face for Info nodes in a node header.")
(defface info-index-match
'((t :inherit match))
"Face used to highlight matches in an index entry."
- :group 'info
:version "24.4")
;; This is a defcustom largely so that we can get the benefit
@@ -249,8 +233,7 @@ Although this is a customizable variable, that is mainly for technical
reasons. Normally, you should either set INFOPATH or customize
`Info-additional-directory-list', rather than changing this variable."
:initialize 'custom-initialize-delay
- :type '(repeat directory)
- :group 'info))
+ :type '(repeat directory)))
(defvar Info-directory-list nil
"List of directories to search for Info documentation files.
@@ -285,8 +268,7 @@ a version of Emacs without installing it.")
(defcustom Info-additional-directory-list nil
"List of additional directories to search for Info documentation files.
These directories are searched after those in `Info-directory-list'."
- :type '(repeat directory)
- :group 'info)
+ :type '(repeat directory))
(defcustom Info-scroll-prefer-subnodes nil
"If non-nil, \\<Info-mode-map>\\[Info-scroll-up] in a menu visits subnodes.
@@ -300,8 +282,7 @@ Setting this option to nil results in behavior similar to the stand-alone
Info reader program, which visits the first subnode from the menu only
when you hit the end of the current node."
:version "22.1"
- :type 'boolean
- :group 'info)
+ :type 'boolean)
(defcustom Info-hide-note-references t
"If non-nil, hide the tag and section reference in *note and * menu items.
@@ -320,8 +301,7 @@ If this is non-nil, you may wish setting `Info-refill-paragraphs' non-nil."
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (derived-mode-p 'Info-mode)
- (revert-buffer t t)))))
- :group 'info)
+ (revert-buffer t t))))))
(defcustom Info-refill-paragraphs nil
"If non-nil, attempt to refill paragraphs with hidden references.
@@ -329,15 +309,13 @@ This refilling may accidentally remove explicit line breaks in the Info
file, so be prepared for a few surprises if you enable this feature.
This only has an effect if `Info-hide-note-references' is non-nil."
:version "22.1"
- :type 'boolean
- :group 'info)
+ :type 'boolean)
(defcustom Info-breadcrumbs-depth 4
"Depth of breadcrumbs to display.
0 means do not display breadcrumbs."
:version "23.1"
- :type 'integer
- :group 'info)
+ :type 'integer)
(defcustom Info-search-whitespace-regexp "\\s-+"
"If non-nil, regular expression to match a sequence of whitespace chars.
@@ -347,8 +325,7 @@ In the Customization buffer, that is `[' followed by a space,
a tab, a carriage return (control-M), a newline, and `]+'. Don't
add any capturing groups into this value; that can change the
numbering of existing capture groups in unexpected ways."
- :type 'regexp
- :group 'info)
+ :type 'regexp)
(defcustom Info-isearch-search t
"If non-nil, isearch in Info searches through multiple nodes.
@@ -363,8 +340,7 @@ node depending on search direction.
Setting this option to nil restores the default isearch behavior
with wrapping around the current Info node."
:version "22.1"
- :type 'boolean
- :group 'info)
+ :type 'boolean)
(defvar Info-isearch-initial-node nil)
(defvar Info-isearch-initial-history nil)
@@ -375,13 +351,11 @@ with wrapping around the current Info node."
(unless (and (boundp 'Info-fontify) (null Info-fontify))
'(turn-on-font-lock))
"Hook run when activating Info Mode."
- :type 'hook
- :group 'info)
+ :type 'hook)
(defcustom Info-selection-hook nil
"Hook run when an Info node is selected as the current node."
- :type 'hook
- :group 'info)
+ :type 'hook)
(defvar-local Info-current-file nil
"Info file that Info is now looking at, or nil.
@@ -639,14 +613,14 @@ Do the right thing if the file has been compressed or zipped."
(insert-file-contents-literally fullname visit)
(let ((inhibit-read-only t)
(coding-system-for-write 'no-conversion)
- (inhibit-nul-byte-detection t) ; Index nodes include null bytes
+ (inhibit-null-byte-detection t) ; Index nodes include null bytes
(default-directory (or (file-name-directory fullname)
default-directory)))
(or (consp decoder)
(setq decoder (list decoder)))
(apply #'call-process-region (point-min) (point-max)
(car decoder) t t nil (cdr decoder))))
- (let ((inhibit-nul-byte-detection t)) ; Index nodes include null bytes
+ (let ((inhibit-null-byte-detection t)) ; Index nodes include null bytes
(insert-file-contents fullname visit)))
;; Clear the caches of modified Info files.
@@ -957,6 +931,7 @@ This function first looks for a case-sensitive match for NODENAME;
if none is found it then tries a case-insensitive match (unless
STRICT-CASE is non-nil)."
(info-initialize)
+ (setq nodename (info--node-canonicalize-whitespace nodename))
(setq filename (Info-find-file filename))
;; Go into Info buffer.
(or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
@@ -1375,7 +1350,7 @@ is non-nil)."
;; Index nodes include null bytes. DIR
;; files should not have indices, but who
;; knows...
- (let ((inhibit-nul-byte-detection t))
+ (let ((inhibit-null-byte-detection t))
(insert-file-contents file)
(setq Info-dir-file-name file)
(push (current-buffer) buffers)
@@ -1473,9 +1448,10 @@ is non-nil)."
(defvar Info-streamline-headings
'(("Emacs" . "Emacs")
- ("Programming" . "Programming")
+ ("Software development\\|Programming" . "Software development")
("Libraries" . "Libraries")
- ("World Wide Web\\|Net Utilities" . "Net Utilities"))
+ ("Network applications\\|World Wide Web\\|Net Utilities"
+ . "Network applications"))
"List of elements (RE . NAME) to merge headings matching RE to NAME.")
(defun Info-dir-remove-duplicates ()
@@ -1996,12 +1972,9 @@ the Top node in FILENAME."
"Search for REGEXP, starting from point, and select node it's found in.
If DIRECTION is `backward', search in the reverse direction."
(interactive (list (read-string
- (if Info-search-history
- (format "Regexp search%s (default %s): "
- (if case-fold-search "" " case-sensitively")
- (car Info-search-history))
- (format "Regexp search%s: "
- (if case-fold-search "" " case-sensitively")))
+ (format-prompt
+ "Regexp search%s" (car Info-search-history)
+ (if case-fold-search "" " case-sensitively"))
nil 'Info-search-history)))
(deactivate-mark)
(when (equal regexp "")
@@ -2125,12 +2098,9 @@ If DIRECTION is `backward', search in the reverse direction."
(defun Info-search-backward (regexp &optional bound noerror count)
"Search for REGEXP in the reverse direction."
(interactive (list (read-string
- (if Info-search-history
- (format "Regexp search%s backward (default %s): "
- (if case-fold-search "" " case-sensitively")
- (car Info-search-history))
- (format "Regexp search%s backward: "
- (if case-fold-search "" " case-sensitively")))
+ (format-prompt
+ "Regexp search%s backward" (car Info-search-history)
+ (if case-fold-search "" " case-sensitively"))
nil 'Info-search-history)))
(Info-search regexp bound noerror count 'backward))
@@ -2309,7 +2279,11 @@ If SAME-FILE is non-nil, do not move to a different Info file."
nil t))
(progn (beginning-of-line) (if (looking-at "^\\* ") (forward-char 2)))
(goto-char p)
- (Info-restore-point Info-history)))))
+ (Info-restore-point Info-history))))
+ ;; If scroll-conservatively is non-zero and less than 101, display
+ ;; as much of the superior node above the target line as possible.
+ (when (< 0 scroll-conservatively 101)
+ (recenter)))
(defun Info-history-back ()
"Go back in the history to the last node visited."
@@ -2687,14 +2661,16 @@ Because of ambiguities, this should be concatenated with something like
;;; (setq Info-point-loc
;;; (buffer-substring (match-beginning 0) (1- (match-beginning 1))))
)
- (replace-regexp-in-string
- "[ \n]+" " "
+ (info--node-canonicalize-whitespace
(or (and (not (equal (match-string-no-properties 2) ""))
(match-string-no-properties 2))
;; If the node name is the menu entry name (using `entry::').
(buffer-substring-no-properties
(match-beginning 0) (1- (match-beginning 1)))))))
+(defun info--node-canonicalize-whitespace (string)
+ (replace-regexp-in-string "[ \t\n]+" " " string))
+
;; No one calls this.
;;(defun Info-menu-item-sequence (list)
;; (while list
@@ -2772,6 +2748,8 @@ Because of ambiguities, this should be concatenated with something like
;; Go back to the start node (for the next completion).
(unless (equal Info-current-node orignode)
(Info-goto-node orignode))
+ ;; Arrange list to be in order found in node.
+ (setq completions (nreverse completions))
;; Update the cache.
(setq Info-complete-cache
(list Info-current-file Info-current-node
@@ -2811,10 +2789,7 @@ new buffer."
(while (null item)
(setq item (let ((completion-ignore-case t)
(Info-complete-menu-buffer (current-buffer)))
- (completing-read (if default
- (format "Menu item (default %s): "
- default)
- "Menu item: ")
+ (completing-read (format-prompt "Menu item" default)
#'Info-complete-menu-item nil t nil nil
default))))
(list item current-prefix-arg))))
@@ -3791,20 +3766,8 @@ Build a menu of the possible matches."
;; there is no "nxml.el" (it's nxml-mode.el).
;; But package.el makes the same assumption.
;; I think nxml is the only exception - maybe it should be just be renamed.
- (let ((str (ignore-errors (lm-commentary (find-library-name nodename)))))
- (if (null str)
- (insert "Can’t find package description.\n\n")
- (insert
- (with-temp-buffer
- (insert str)
- (goto-char (point-min))
- (delete-blank-lines)
- (goto-char (point-max))
- (delete-blank-lines)
- (goto-char (point-min))
- (while (re-search-forward "^;+ ?" nil t)
- (replace-match "" nil nil))
- (buffer-string))))))))
+ (insert (or (ignore-errors (lm-commentary (find-library-name nodename)))
+ (insert "Can’t find package description.\n\n"))))))
;;;###autoload
(defun info-finder (&optional keywords)
@@ -4066,6 +4029,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "^" 'Info-up)
(define-key map "," 'Info-index-next)
(define-key map "\177" 'Info-scroll-down)
+ (define-key map [remap goto-line] 'goto-line-relative)
(define-key map [mouse-2] 'Info-mouse-follow-nearest-node)
(define-key map [follow-link] 'mouse-face)
(define-key map [XF86Back] 'Info-history-back)
@@ -4102,22 +4066,28 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:help "Go to top node of file"]
["Final Node" Info-final-node
:help "Go to final node in this file"]
+ "---"
("Menu Item" ["You should never see this" report-emacs-bug t])
("Reference" ["You should never see this" report-emacs-bug t])
["Search..." Info-search
:help "Search for regular expression in this Info file"]
["Search Next" Info-search-next
:help "Search for another occurrence of regular expression"]
- ["Go to Node..." Info-goto-node
+ "---"
+ ("History"
+ ["Back in history" Info-history-back :active Info-history
+ :help "Go back in history to the last node you were at"]
+ ["Forward in history" Info-history-forward :active Info-history-forward
+ :help "Go forward in history"]
+ ["Show History" Info-history :active Info-history-list
+ :help "Go to menu of visited nodes"])
+ ("Go to"
+ ["Go to Node..." Info-goto-node
:help "Go to a named node"]
- ["Back in history" Info-history-back :active Info-history
- :help "Go back in history to the last node you were at"]
- ["Forward in history" Info-history-forward :active Info-history-forward
- :help "Go forward in history"]
- ["History" Info-history :active Info-history-list
- :help "Go to menu of visited nodes"]
- ["Table of Contents" Info-toc
- :help "Go to table of contents"]
+ ["Table of Contents" Info-toc
+ :help "Go to table of contents"]
+ ["Go to Directory" Info-directory
+ :help "Go to the Info directory node."])
("Index"
["Lookup a String..." Info-index
:help "Look for a string in the index items"]
@@ -4131,6 +4101,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:help "Copy the name of the current node into the kill ring"]
["Clone Info buffer" clone-buffer
:help "Create a twin copy of the current Info buffer."]
+ "---"
["Exit" quit-window :help "Stop reading Info"]))
@@ -4381,6 +4352,7 @@ Moving within a node:
already visible, try to go to the previous menu entry, or up
if there is none.
\\[beginning-of-buffer] Go to beginning of node.
+\\[end-of-buffer] Go to end of node.
Advanced commands:
\\[Info-search] Search through this Info file for specified regexp,
@@ -5146,9 +5118,8 @@ first line or header line, and for breadcrumb links.")
"Additional menu-items to add to speedbar frame.")
;; Make sure our special speedbar major mode is loaded
-(if (featurep 'speedbar)
- (Info-install-speedbar-variables)
- (add-hook 'speedbar-load-hook 'Info-install-speedbar-variables))
+(with-eval-after-load 'speedbar
+ (Info-install-speedbar-variables))
;;; Info hierarchy display method
;;;###autoload
diff --git a/lisp/informat.el b/lisp/informat.el
index 9873f66f215..7750ab00898 100644
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -337,7 +337,7 @@ Check that every node pointer points to an existing node."
(point))))
(Info-extract-menu-node-name))))
(goto-char (point-min))
- (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t)
+ (while (re-search-forward "\\*note\\>[^:\t]*:" nil t)
(goto-char (+ (match-beginning 0) 5))
(skip-chars-forward " \n")
(Info-validate-node-name
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index d3ae23c2f70..3b3fcf4c041 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -196,7 +196,9 @@
"Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and
increment it. If IC is specified, embed DATA at IC."
(if ic
- (aset ccl-program-vector ic (ccl-fixnum data))
+ (aset ccl-program-vector ic (if (numberp data)
+ (ccl-fixnum data)
+ data))
(let ((len (length ccl-program-vector)))
(if (>= ccl-current-ic len)
(let ((new (make-vector (* len 2) nil)))
@@ -204,7 +206,9 @@ increment it. If IC is specified, embed DATA at IC."
(setq len (1- len))
(aset new len (aref ccl-program-vector len)))
(setq ccl-program-vector new))))
- (aset ccl-program-vector ccl-current-ic (ccl-fixnum data))
+ (aset ccl-program-vector ccl-current-ic (if (numberp data)
+ (ccl-fixnum data)
+ data))
(setq ccl-current-ic (1+ ccl-current-ic))))
(defun ccl-embed-symbol (symbol prop)
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index b7656d9c1a7..0b6920cf180 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -60,7 +60,7 @@ Vietnamese")
;; For each group (row) of 2-byte character sets.
(define-category ?A "2-byte alnum
-Alpha-numeric characters of 2-byte character sets")
+Alphanumeric characters of 2-byte character sets")
(define-category ?C "2-byte han
Chinese (Han) characters of 2-byte character sets")
(define-category ?G "2-byte Greek
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 23abb0d0a9e..a52b6283c3e 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -191,6 +191,7 @@
(kanbun #x319D)
(han #x5B57)
(yi #xA288)
+ (javanese #xA980)
(cham #xAA00)
(tai-viet #xAA80)
(hangul #xAC00)
@@ -723,6 +724,7 @@
symbol
braille
yi
+ javanese
tai-viet
aegean-number
ancient-greek-number
diff --git a/lisp/international/isearch-x.el b/lisp/international/isearch-x.el
index d77234ec77b..f50f86a035f 100644
--- a/lisp/international/isearch-x.el
+++ b/lisp/international/isearch-x.el
@@ -51,6 +51,17 @@
(setq input-method-function nil)
(isearch-update))
+;;;###autoload
+(defun isearch-transient-input-method ()
+ "Activate transient input method in interactive search."
+ (interactive)
+ (let ((overriding-terminal-local-map nil))
+ (activate-transient-input-method))
+ (setq isearch-input-method-function input-method-function
+ isearch-input-method-local-p t)
+ (setq input-method-function nil)
+ (isearch-update))
+
(defvar isearch-minibuffer-local-map
(let ((map (copy-keymap minibuffer-local-map)))
(define-key map [with-keyboard-coding] 'isearch-with-keyboard-coding)
@@ -117,6 +128,7 @@
(cons last-char unread-command-events))
;; Inherit current-input-method in a minibuffer.
str (read-string prompt isearch-message 'junk-hist nil t))
+ (deactivate-transient-input-method)
(if (or (not str) (< (length str) (length isearch-message)))
;; All inputs were deleted while the input method
;; was working.
diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el
index e86efe5827b..0df07d65148 100644
--- a/lisp/international/iso-ascii.el
+++ b/lisp/international/iso-ascii.el
@@ -1,4 +1,4 @@
-;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals
+;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals -*- lexical-binding: t -*-
;; Copyright (C) 1987, 1995, 1998, 2001-2020 Free Software Foundation,
;; Inc.
@@ -41,8 +41,7 @@
(defcustom iso-ascii-convenient nil
"Non-nil means `iso-ascii' should aim for convenience, not precision."
- :type 'boolean
- :group 'iso-ascii)
+ :type 'boolean)
(defvar iso-ascii-display-table (make-display-table)
"Display table used for ISO-ASCII mode.")
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index 45e13462656..5f645b6e8e4 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -48,7 +48,7 @@
(defvar ja-dic-filename "ja-dic.el")
(defun skkdic-convert-okuri-ari (skkbuf buf)
- (byte-compile-info-message "Processing OKURI-ARI entries")
+ (byte-compile-info "Processing OKURI-ARI entries" t)
(goto-char (point-min))
(with-current-buffer buf
(insert ";; Setting okuri-ari entries.\n"
@@ -97,7 +97,7 @@
("ゆã" "行")))
(defun skkdic-convert-postfix (skkbuf buf)
- (byte-compile-info-message "Processing POSTFIX entries")
+ (byte-compile-info "Processing POSTFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
(insert ";; Setting postfix entries.\n"
@@ -151,7 +151,7 @@
(defconst skkdic-prefix-list '(skkdic-prefix-list))
(defun skkdic-convert-prefix (skkbuf buf)
- (byte-compile-info-message "Processing PREFIX entries")
+ (byte-compile-info "Processing PREFIX entries" t)
(goto-char (point-min))
(with-current-buffer buf
(insert ";; Setting prefix entries.\n"
@@ -273,7 +273,7 @@
(defun skkdic-collect-okuri-nasi ()
(save-excursion
(let ((progress (make-progress-reporter
- (byte-compile-info-message "Collecting OKURI-NASI entries")
+ (byte-compile-info "Collecting OKURI-NASI entries" t)
(point) (point-max)
nil 10)))
(while (re-search-forward "^\\(\\cH+\\) \\(/\\cj.*\\)/$"
@@ -301,7 +301,7 @@
"(skkdic-set-okuri-nasi\n")
(let ((l (nreverse skkdic-okuri-nasi-entries))
(progress (make-progress-reporter
- (byte-compile-info-message "Processing OKURI-NASI entries")
+ (byte-compile-info "Processing OKURI-NASI entries" t)
0 skkdic-okuri-nasi-entries-count
nil 10))
(count 0))
@@ -329,12 +329,12 @@ Optional argument DIRNAME if specified is the directory name under which
the generated Emacs Lisp is saved.
The name of generated file is specified by the variable `ja-dic-filename'."
(interactive "FSKK dictionary file: ")
- (let* ((coding-system-for-read 'euc-japan)
- (skkbuf (get-buffer-create " *skkdic-unannotated*"))
+ (let* ((skkbuf (get-buffer-create " *skkdic-unannotated*"))
(buf (get-buffer-create "*skkdic-work*")))
;; Set skkbuf to an unannotated copy of the dictionary.
(with-current-buffer skkbuf
- (insert-file-contents (expand-file-name filename))
+ (let ((coding-system-for-read 'euc-japan))
+ (insert-file-contents (expand-file-name filename)))
(re-search-forward "^[^;]")
(while (re-search-forward ";[^\n/]*/" nil t)
(replace-match "/")))
@@ -531,8 +531,7 @@ To get complete usage, invoke:
',(let ((l entries)
(map '(skdic-okuri-nasi))
(progress (make-progress-reporter
- (byte-compile-info-message
- "Extracting OKURI-NASI entries")
+ (byte-compile-info "Extracting OKURI-NASI entries")
0 (length entries)))
(count 0)
entry)
diff --git a/lisp/international/kinsoku.el b/lisp/international/kinsoku.el
index 54bf0e95313..4e9b6b015a5 100644
--- a/lisp/international/kinsoku.el
+++ b/lisp/international/kinsoku.el
@@ -182,4 +182,6 @@ the context of text formatting."
(aref (char-category-set (preceding-char)) ?<))
(kinsoku-shorter linebeg))))
+(provide 'kinsoku)
+
;;; kinsoku.el ends here
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 9644b0effd6..1e6fea8578c 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -55,6 +55,7 @@
;; Keep "C-x C-m ..." for mule specific commands.
(define-key ctl-x-map "\C-m" mule-keymap)
+(define-key ctl-x-map "\\" 'activate-transient-input-method)
(defvar describe-language-environment-map
(let ((map (make-sparse-keymap "Describe Language Environment")))
@@ -139,8 +140,8 @@
`(menu-item "Set Coding Systems" ,set-coding-system-map))
(bindings--define-key map [separator-input-method] menu-bar-separator)
- (bindings--define-key map [describe-input-method]
- '(menu-item "Describe Input Method" describe-input-method))
+ (bindings--define-key map [activate-transient-input-method]
+ '(menu-item "Transient Input Method" activate-transient-input-method))
(bindings--define-key map [set-input-method]
'(menu-item "Select Input Method..." set-input-method))
(bindings--define-key map [toggle-input-method]
@@ -283,53 +284,57 @@ wrong, use this command again to toggle back to the right mode."
(interactive)
(view-file (expand-file-name "HELLO" data-directory)))
+(defvar mule-cmds--prefixed-command-next-coding-system nil)
+(defvar mule-cmds--prefixed-command-last-coding-system nil)
+
+(defun mule-cmds--prefixed-command-pch ()
+ (if (not mule-cmds--prefixed-command-next-coding-system)
+ (progn
+ (remove-hook 'pre-command-hook #'mule-cmds--prefixed-command-pch)
+ (remove-hook 'prefix-command-echo-keystrokes-functions
+ #'mule-cmds--prefixed-command-echo)
+ (remove-hook 'prefix-command-preserve-state-hook
+ #'mule-cmds--prefixed-command-preserve))
+ (setq this-command
+ (let ((cmd this-command)
+ (coding-system mule-cmds--prefixed-command-next-coding-system))
+ (lambda ()
+ (interactive)
+ (setq this-command cmd)
+ (let ((coding-system-for-read coding-system)
+ (coding-system-for-write coding-system)
+ (coding-system-require-warning t))
+ (call-interactively cmd)))))
+ (setq mule-cmds--prefixed-command-last-coding-system
+ mule-cmds--prefixed-command-next-coding-system)
+ (setq mule-cmds--prefixed-command-next-coding-system nil)))
+
+(defun mule-cmds--prefixed-command-echo ()
+ (when mule-cmds--prefixed-command-next-coding-system
+ (format "With coding-system %S"
+ mule-cmds--prefixed-command-next-coding-system)))
+
+(defun mule-cmds--prefixed-command-preserve ()
+ (setq mule-cmds--prefixed-command-next-coding-system
+ mule-cmds--prefixed-command-last-coding-system))
+
(defun universal-coding-system-argument (coding-system)
- "Execute an I/O command using the specified coding system."
+ "Execute an I/O command using the specified CODING-SYSTEM."
(interactive
(let ((default (and buffer-file-coding-system
(not (eq (coding-system-type buffer-file-coding-system)
'undecided))
buffer-file-coding-system)))
(list (read-coding-system
- (if default
- (format "Coding system for following command (default %s): " default)
- "Coding system for following command: ")
+ (format-prompt "Coding system for following command" default)
default))))
- ;; FIXME: This "read-key-sequence + call-interactively" loop is trying to
- ;; reproduce the normal command loop, but this "can't" be done faithfully so
- ;; it necessarily suffers from breakage in corner cases (e.g. it fails to run
- ;; pre/post-command-hook, doesn't properly set this-command/last-command, it
- ;; doesn't handle keyboard macros, ...).
- (let* ((keyseq (read-key-sequence
- (format "Command to execute with %s:" coding-system)))
- (cmd (key-binding keyseq)))
- ;; read-key-sequence ignores quit, so make an explicit check.
- (if (equal last-input-event (nth 3 (current-input-mode)))
- (keyboard-quit))
- (when (memq cmd '(universal-argument digit-argument))
- (call-interactively cmd)
-
- ;; Process keys bound in `universal-argument-map'.
- (while (progn
- (setq keyseq (read-key-sequence nil t)
- cmd (key-binding keyseq t))
- (memq cmd '(negative-argument digit-argument
- universal-argument-more)))
- (setq current-prefix-arg prefix-arg prefix-arg nil)
- ;; Have to bind `last-command-event' here so that
- ;; `digit-argument', for instance, can compute the
- ;; `prefix-arg'.
- (setq last-command-event (aref keyseq 0))
- (call-interactively cmd)))
-
- (let ((coding-system-for-read coding-system)
- (coding-system-for-write coding-system)
- (coding-system-require-warning t))
- (setq current-prefix-arg prefix-arg prefix-arg nil)
- ;; Have to bind `last-command-event' e.g. for `self-insert-command'.
- (setq last-command-event (aref keyseq 0))
- (message "")
- (call-interactively cmd))))
+ (prefix-command-preserve-state)
+ (setq mule-cmds--prefixed-command-next-coding-system coding-system)
+ (add-hook 'pre-command-hook #'mule-cmds--prefixed-command-pch)
+ (add-hook 'prefix-command-echo-keystrokes-functions
+ #'mule-cmds--prefixed-command-echo)
+ (add-hook 'prefix-command-preserve-state-hook
+ #'mule-cmds--prefixed-command-preserve))
(defun set-default-coding-systems (coding-system)
"Set default value of various coding systems to CODING-SYSTEM.
@@ -486,8 +491,8 @@ non-nil, it is used to sort CODINGS instead."
0)))
1)
))))))
- (sort codings (function (lambda (x y)
- (> (funcall func x) (funcall func y))))))))
+ (sort codings (lambda (x y)
+ (> (funcall func x) (funcall func y)))))))
(defun find-coding-systems-region (from to)
"Return a list of proper coding systems to encode a text between FROM and TO.
@@ -607,9 +612,8 @@ When called from a program, the value is the position of the unencodable
character found, or nil if all characters are encodable."
(interactive
(list (let ((default (or buffer-file-coding-system 'us-ascii)))
- (read-coding-system
- (format "Coding-system (default %s): " default)
- default))))
+ (read-coding-system (format-prompt "Coding-system" default)
+ default))))
(let ((pos (unencodable-char-position (point) (point-max) coding-system)))
(if pos
(goto-char (1+ pos))
@@ -700,8 +704,8 @@ DEFAULT is the coding system to use by default in the query."
;; buffer is displayed.
(when (and unsafe (not (stringp from)))
(pop-to-buffer bufname)
- (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x)))
- unsafe))))
+ (goto-char (apply #'min (mapcar (lambda (x) (or (car (cadr x)) (point-max)))
+ unsafe))))
;; Then ask users to select one from CODINGS while showing
;; the reason why none of the defaults are not used.
(with-output-to-temp-buffer "*Warning*"
@@ -798,9 +802,8 @@ or specify any other coding system (and risk losing\n\
;; Read a coding system.
(setq coding-system
- (read-coding-system
- (format "Select coding system (default %s): " default)
- default))
+ (read-coding-system (format-prompt "Select coding system" default)
+ default))
(setq last-coding-system-specified coding-system))
(kill-buffer "*Warning*")
@@ -885,7 +888,7 @@ It is highly recommended to fix it before writing to a file."
;; Change elements of the list to (coding . base-coding).
(setq default-coding-system
- (mapcar (function (lambda (x) (cons x (coding-system-base x))))
+ (mapcar (lambda (x) (cons x (coding-system-base x)))
default-coding-system))
(if (and auto-cs (not no-other-defaults))
@@ -1079,7 +1082,7 @@ it asks the user to select a proper coding system."
(if (fboundp select-safe-coding-system-function)
(funcall select-safe-coding-system-function
(point-min) (point-max) coding
- (function (lambda (x) (coding-system-get x :mime-charset))))
+ (lambda (x) (coding-system-get x :mime-charset)))
coding)))
;;; Language support stuff.
@@ -1258,7 +1261,7 @@ This returns a language environment name as a string."
(name (completing-read prompt
language-info-alist
(and key
- (function (lambda (elm) (and (listp elm) (assq key elm)))))
+ (lambda (elm) (and (listp elm) (assq key elm))))
t nil nil default)))
(if (and (> (length name) 0)
(or (not key)
@@ -1342,6 +1345,29 @@ This is the input method activated automatically by the command
mule-input-method-string)
:set-after '(current-language-environment))
+(defcustom default-transient-input-method nil
+ "Default transient input method.
+This is the input method activated by the command
+`activate-transient-input-method' (\\[activate-transient-input-method])."
+ :link '(custom-manual "(emacs)Input Methods")
+ :group 'mule
+ :type '(choice (const nil)
+ mule-input-method-string)
+ :set-after '(current-language-environment)
+ :version "28.1")
+
+(defvar current-transient-input-method nil
+ "The current input method temporarily enabled by `activate-transient-input-method'.
+If nil, that means no transient input method is active now.")
+(make-variable-buffer-local 'current-transient-input-method)
+(put 'current-transient-input-method 'permanent-local t)
+
+(defvar previous-transient-input-method nil
+ "The input method that was active before enabling the transient input method.
+If nil, that means no previous input method was active.")
+(make-variable-buffer-local 'previous-transient-input-method)
+(put 'previous-transient-input-method 'permanent-local t)
+
(put 'input-method-function 'permanent-local t)
(defvar input-method-history nil
@@ -1402,13 +1428,13 @@ The commands `describe-input-method' and `list-input-methods' need
these duplicated values to show some information about input methods
without loading the relevant Quail packages.
\n(fn INPUT-METHOD LANG-ENV ACTIVATE-FUNC TITLE DESCRIPTION &rest ARGS)"
- (if (symbolp lang-env)
- (setq lang-env (symbol-name lang-env))
- (setq lang-env (purecopy lang-env)))
- (if (symbolp input-method)
- (setq input-method (symbol-name input-method))
- (setq input-method (purecopy input-method)))
- (setq args (mapcar 'purecopy args))
+ (setq lang-env (if (symbolp lang-env)
+ (symbol-name lang-env)
+ (purecopy lang-env)))
+ (setq input-method (if (symbolp input-method)
+ (symbol-name input-method)
+ (purecopy input-method)))
+ (setq args (mapcar #'purecopy args))
(let ((info (cons lang-env args))
(slot (assoc input-method input-method-alist)))
(if slot
@@ -1476,7 +1502,8 @@ If INPUT-METHOD is nil, deactivate any current input method."
(defun deactivate-input-method ()
"Turn off the current input method."
(when current-input-method
- (add-to-history 'input-method-history current-input-method)
+ (unless current-transient-input-method
+ (add-to-history 'input-method-history current-input-method))
(unwind-protect
(progn
(setq input-method-function nil
@@ -1538,7 +1565,9 @@ which marks the variable `default-input-method' as set for Custom buffers."
(if toggle-input-method-active
(error "Recursive use of `toggle-input-method'"))
(if (and current-input-method (not arg))
- (deactivate-input-method)
+ (if current-transient-input-method
+ (deactivate-transient-input-method)
+ (deactivate-input-method))
(let ((toggle-input-method-active t)
(default (or (car input-method-history) default-input-method)))
(if (and arg default (equal current-input-method default)
@@ -1557,6 +1586,42 @@ which marks the variable `default-input-method' as set for Custom buffers."
(when interactive
(customize-mark-as-set 'default-input-method)))))))
+(defun activate-transient-input-method (&optional arg interactive)
+ "Select and enable a transient input method for the current buffer.
+If `default-transient-input-method' was not yet defined, prompt for it."
+ (interactive "P\np")
+ (when (or arg (not default-transient-input-method))
+ (let* ((default (or (car input-method-history) default-input-method))
+ (input-method
+ (read-input-method-name
+ (format-prompt "Transient input method" default)
+ default t)))
+ (setq default-transient-input-method input-method)
+ (when interactive
+ (customize-mark-as-set 'default-transient-input-method))))
+ (let* ((clearfun (make-symbol "clear-transient-input-method"))
+ (exitfun
+ (lambda ()
+ (deactivate-transient-input-method)
+ (remove-hook 'input-method-after-insert-chunk-hook clearfun))))
+ (fset clearfun (lambda () (funcall exitfun)))
+ (add-hook 'input-method-after-insert-chunk-hook clearfun)
+ (setq previous-transient-input-method current-input-method)
+ (when previous-transient-input-method
+ (deactivate-input-method))
+ (activate-input-method default-transient-input-method)
+ (setq current-transient-input-method default-transient-input-method)
+ exitfun))
+
+(defun deactivate-transient-input-method ()
+ "Disable currently active transient input method for the current buffer."
+ (when current-transient-input-method
+ (deactivate-input-method)
+ (when previous-transient-input-method
+ (activate-input-method previous-transient-input-method)
+ (setq previous-transient-input-method nil))
+ (setq current-transient-input-method nil)))
+
(autoload 'help-buffer "help-mode")
(defun describe-input-method (input-method)
@@ -1797,13 +1862,11 @@ The default status is as follows:
'raw-text)
(set-default-coding-systems nil)
- (setq default-sendmail-coding-system 'iso-latin-1)
- ;; On Darwin systems, this should be utf-8-unix, but when this file is loaded
- ;; that is not yet defined, so we set it in set-locale-environment instead.
- ;; [Actually, it seems to work fine to use utf-8-unix here, and not just
- ;; on Darwin. The previous comment seems to be outdated?
- ;; See patch at https://debbugs.gnu.org/15803 ]
- (setq default-file-name-coding-system 'iso-latin-1-unix)
+ (setq default-sendmail-coding-system 'utf-8)
+ (setq default-file-name-coding-system (if (memq system-type
+ '(window-nt ms-dos))
+ 'iso-latin-1-unix
+ 'utf-8-unix))
;; Preserve eol-type from existing default-process-coding-systems.
;; On non-unix-like systems in particular, these may have been set
;; carefully by the user, or by the startup code, to deal with the
@@ -1819,8 +1882,10 @@ The default status is as follows:
(input-coding
(condition-case nil
(coding-system-change-text-conversion
- (cdr default-process-coding-system) 'iso-latin-1)
- (coding-system-error 'iso-latin-1))))
+ (cdr default-process-coding-system)
+ (if (memq system-type '(window-nt ms-dos)) 'iso-latin-1 'utf-8))
+ (coding-system-error
+ (if (memq system-type '(window-nt ms-dos)) 'iso-latin-1 'utf-8)))))
(setq default-process-coding-system
(cons output-coding input-coding)))
@@ -2064,12 +2129,6 @@ See `set-language-info-alist' for use in programs."
"Do various unibyte-mode setups for language environment LANGUAGE-NAME."
(set-display-table-and-terminal-coding-system language-name))
-(defun princ-list (&rest args)
- "Print all arguments with `princ', then print \"\\n\"."
- (declare (obsolete "use mapc and princ instead." "23.3"))
- (mapc #'princ args)
- (princ "\n"))
-
(put 'describe-specified-language-support 'apropos-inhibit t)
;; Print language-specific information such as input methods,
@@ -2906,9 +2965,9 @@ STR should be a unibyte string."
(mapconcat
(if (and coding-system (eq (coding-system-type coding-system) 'iso-2022))
;; Try to get a pretty description for ISO 2022 escape sequences.
- (function (lambda (x) (or (cdr (assq x iso-2022-control-alist))
- (format "#x%02X" x))))
- (function (lambda (x) (format "#x%02X" x))))
+ (lambda (x) (or (cdr (assq x iso-2022-control-alist))
+ (format "#x%02X" x)))
+ (lambda (x) (format "#x%02X" x)))
str " "))
(defun encode-coding-char (char coding-system &optional charset)
@@ -2962,11 +3021,6 @@ on encoding."
;; Doc said "obsolete" in 23.1, this statement only added in 24.1.
(make-obsolete 'unify-8859-on-decoding-mode "don't use it." "23.1")
-(defvar nonascii-insert-offset 0)
-(make-obsolete-variable 'nonascii-insert-offset "do not use it." "23.1")
-(defvar nonascii-translation-table nil)
-(make-obsolete-variable 'nonascii-translation-table "do not use it." "23.1")
-
(defvar ucs-names nil
"Hash table of cached CHAR-NAME keys to CHAR-CODE values.")
@@ -3015,6 +3069,15 @@ on encoding."
;; higher code, so it gets pushed later!
(if new-name (puthash new-name c names))
(if old-name (puthash old-name c names))
+ ;; Unicode uses the spelling "lamda" in character
+ ;; names, instead of "lambda", due to "preferences
+ ;; expressed by the Greek National Body" (Bug#30513).
+ ;; Some characters have an old-name with the "lambda"
+ ;; spelling, but others don't. Add the traditional
+ ;; spelling for more convenient completion.
+ (when (and (not old-name) new-name
+ (string-match "\\<LAMDA\\>" new-name))
+ (puthash (replace-match "LAMBDA" t t new-name) c names))
(setq c (1+ c))))))
;; Special case for "BELL" which is apparently the only char which
;; doesn't have a new name and whose old-name is shadowed by a newer
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index e6e6135243f..99449ad359f 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -39,7 +39,7 @@
;; Society of Japan/Information Technology Standards Commission of
;; Japan (IPSJ/ITSCJ) at https://www.itscj.ipsj.or.jp/itscj_english/.
;; Standards docs equivalent to iso-2022 and iso-8859 are at
-;; http://www.ecma.ch/.
+;; https://www.ecma.ch/.
;; FWIW, http://www.microsoft.com/globaldev/ lists the following for
;; MS Windows, which are presumably the only charsets we really need
@@ -1251,7 +1251,9 @@ by UTF-8."
:coding-type 'undecided
:mnemonic ?-
:charset-list '(emacs)
- :prefer-utf-8 t)
+ :prefer-utf-8 t
+ :inhibit-null-byte-detection 0
+ :inhibit-iso-escape-detection 0)
(define-coding-system 'raw-text
"Raw text, which means text contains random 8-bit codes.
@@ -1508,6 +1510,7 @@ for decoding and encoding files, process I/O, etc."
:mime-charset 'us-ascii)
(define-coding-system-alias 'iso-safe 'us-ascii)
+(define-coding-system-alias 'ascii 'us-ascii)
(define-coding-system 'utf-7
"UTF-7 encoding of Unicode (RFC 2152)."
@@ -1517,6 +1520,10 @@ for decoding and encoding files, process I/O, etc."
:charset-list '(unicode)
:pre-write-conversion 'utf-7-pre-write-conversion
:post-read-conversion 'utf-7-post-read-conversion)
+;; FIXME: 'define-coding-system' automatically sets :ascii-compatible-p,
+;; to any encoding whose :coding-type is 'utf-8', but UTF-7 is not ASCII
+;; compatible, so we override that here (bug#40407).
+(coding-system-put 'utf-7 :ascii-compatible-p nil)
(define-coding-system 'utf-7-imap
"UTF-7 encoding of Unicode, IMAP version (RFC 2060)"
@@ -1525,6 +1532,8 @@ for decoding and encoding files, process I/O, etc."
:charset-list '(unicode)
:pre-write-conversion 'utf-7-imap-pre-write-conversion
:post-read-conversion 'utf-7-imap-post-read-conversion)
+;; See comment for utf-7 above.
+(coding-system-put 'utf-7-imap :ascii-compatible-p nil)
;; Use us-ascii for terminal output if some other coding system is not
;; specified explicitly.
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 80e78ef7877..b13bde58ca1 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -200,10 +200,6 @@ Character sets for defining other charsets, or for backward compatibility
;;; (charset-iso-graphic-plane charset)
(charset-description charset)))))
-(defvar non-iso-charset-alist nil
- "Obsolete.")
-(make-obsolete-variable 'non-iso-charset-alist "no longer relevant." "23.1")
-
;; A variable to hold charset input history.
(defvar charset-history nil)
diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index 5cc10b1315a..8f316332249 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -44,9 +44,22 @@
(setq i (1+ i)))))
string)
-(defvar truncate-string-ellipsis "..." ;"…"
+(defvar truncate-string-ellipsis nil
"String to use to indicate truncation.
-Serves as default value of ELLIPSIS argument to `truncate-string-to-width'.")
+Serves as default value of ELLIPSIS argument to `truncate-string-to-width'
+returned by the function `truncate-string-ellipsis'.")
+
+(defun truncate-string-ellipsis ()
+ "Return the string used to indicate truncation.
+Use the value of the variable `truncate-string-ellipsis' when it's non-nil.
+Otherwise, return the Unicode character U+2026 \"HORIZONTAL ELLIPSIS\"
+when it's displayable on the selected frame, or `...'. This function
+needs to be called on every use of `truncate-string-to-width' to
+decide whether the selected frame can display that Unicode character."
+ (cond
+ (truncate-string-ellipsis)
+ ((char-displayable-p ?…) "…")
+ ("...")))
;;;###autoload
(defun truncate-string-to-width (str end-column
@@ -73,7 +86,7 @@ If ELLIPSIS is non-nil, it should be a string which will replace the
end of STR (including any padding) if it extends beyond END-COLUMN,
unless the display width of STR is equal to or less than the display
width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS
-defaults to `truncate-string-ellipsis'.
+defaults to `truncate-string-ellipsis', or to three dots when it's nil.
If ELLIPSIS-TEXT-PROPERTY is non-nil, a too-long string will not
be truncated, but instead the elided parts will be covered by a
@@ -81,7 +94,7 @@ be truncated, but instead the elided parts will be covered by a
(or start-column
(setq start-column 0))
(when (and ellipsis (not (stringp ellipsis)))
- (setq ellipsis truncate-string-ellipsis))
+ (setq ellipsis (truncate-string-ellipsis)))
(let ((str-len (length str))
(str-width (string-width str))
(ellipsis-width (if ellipsis (string-width ellipsis) 0))
@@ -275,15 +288,6 @@ operations such as `find-coding-systems-region'."
(put 'with-coding-priority 'edebug-form-spec t)
;;;###autoload
-(defmacro detect-coding-with-priority (from to priority-list)
- "Detect a coding system of the text between FROM and TO with PRIORITY-LIST.
-PRIORITY-LIST is an alist of coding categories vs the corresponding
-coding systems ordered by priority."
- (declare (obsolete with-coding-priority "23.1"))
- `(with-coding-priority (mapcar #'cdr ,priority-list)
- (detect-coding-region ,from ,to)))
-
-;;;###autoload
(defun detect-coding-with-language-environment (from to lang-env)
"Detect a coding system for the text between FROM and TO with LANG-ENV.
The detection takes into account the coding system priorities for the
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index c47f0722544..212e7232b49 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -30,12 +30,13 @@
;;; Code:
-;; FIXME? Are these still relevant? Nothing uses them AFAICS.
(defconst mule-version "6.0 (HANACHIRUSATO)" "\
Version number and name of this version of MULE (multilingual environment).")
+(make-obsolete-variable 'mule-version nil "28.1")
(defconst mule-version-date "2003.9.1" "\
Distribution date of this version of MULE (multilingual environment).")
+(make-obsolete-variable 'mule-version-date nil "28.1")
;;; CHARSET
@@ -407,16 +408,6 @@ PLIST (property list) may contain any type of information a user
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
-(defun charset-id (_charset)
- "Always return 0. This is provided for backward compatibility."
- (declare (obsolete nil "23.1"))
- 0)
-
-(defmacro charset-bytes (_charset)
- "Always return 0. This is provided for backward compatibility."
- (declare (obsolete nil "23.1"))
- 0)
-
(defun get-charset-property (charset propname)
"Return the value of CHARSET's PROPNAME property.
This is the last value stored with
@@ -462,19 +453,8 @@ Return -1 if charset isn't an ISO 2022 one."
"Return long name of CHARSET."
(plist-get (charset-plist charset) :long-name))
-(defun charset-list ()
- "Return list of all charsets ever defined."
- (declare (obsolete charset-list "23.1"))
- charset-list)
-
;;; CHARACTER
-(define-obsolete-function-alias 'char-valid-p 'characterp "23.1")
-
-(defun generic-char-p (_char)
- "Always return nil. This is provided for backward compatibility."
- (declare (obsolete nil "23.1"))
- nil)
(defun make-char-internal (charset-id &optional code1 code2)
(let ((charset (aref emacs-mule-charset-table charset-id)))
@@ -768,11 +748,12 @@ decoded by the coding system itself and before any functions in
`after-insert-functions' are called. This function is passed one
argument: the number of characters in the text to convert, with
point at the start of the text. The function should leave point
-unchanged, and should return the new character count. Note that
-this function should avoid reading from files or receiving text
-from subprocesses -- anything that could invoke decoding; if it
-must do so, it should bind `coding-system-for-read' to a value
-other than the current coding-system, to avoid infinite recursion.
+and the match data unchanged, and should return the new character
+count. Note that this function should avoid reading from files
+or receiving text from subprocesses -- anything that could invoke
+decoding; if it must do so, it should bind
+`coding-system-for-read' to a value other than the current
+coding-system, to avoid infinite recursion.
`:pre-write-conversion'
@@ -780,13 +761,13 @@ VALUE must be a function to call after all functions in
`write-region-annotate-functions' and `buffer-file-format' are
called, and before the text is encoded by the coding system
itself. This function should convert the whole text in the
-current buffer. For backward compatibility, this function is
-passed two arguments which can be ignored. Note that this
-function should avoid writing to files or sending text to
-subprocesses -- anything that could invoke encoding; if it
-must do so, it should bind `coding-system-for-write' to a
-value other than the current coding-system, to avoid infinite
-recursion.
+current buffer, and leave the match data unchanged. For backward
+compatibility, this function is passed two arguments which can be
+ignored. Note that this function should avoid writing to files
+or sending text to subprocesses -- anything that could invoke
+encoding; if it must do so, it should bind
+`coding-system-for-write' to a value other than the current
+coding-system, to avoid infinite recursion.
`:default-char'
@@ -874,10 +855,10 @@ VALUE is a CCL program name defined by `define-ccl-program'. The
CCL program reads a character sequence and writes a byte sequence
as an encoding result.
-`:inhibit-nul-byte-detection'
+`:inhibit-null-byte-detection'
VALUE non-nil means Emacs should ignore null bytes on code detection.
-See the variable `inhibit-nul-byte-detection'. This attribute
+See the variable `inhibit-null-byte-detection'. This attribute
is meaningful only when `:coding-type' is `undecided'.
If VALUE is t, Emacs will ignore null bytes unconditionally while
detecting encoding. If VALUE is non-nil and not t, Emacs will
@@ -929,7 +910,7 @@ non-ASCII files. This attribute is meaningful only when
:ccl-encoder
:valids))
((eq coding-type 'undecided)
- '(:inhibit-nul-byte-detection
+ '(:inhibit-null-byte-detection
:inhibit-iso-escape-detection
:prefer-utf-8))))))
@@ -1090,14 +1071,11 @@ formats (e.g. iso-latin-1-unix, koi8-r-dos)."
(setq codings (cons alias codings))))))
codings))
-(defconst char-coding-system-table nil
- "It exists just for backward compatibility, and the value is always nil.")
-(make-obsolete-variable 'char-coding-system-table nil "23.1")
-
(defun transform-make-coding-system-args (name type &optional doc-string props)
"For internal use only.
Transform XEmacs style args for `make-coding-system' to Emacs style.
Value is a list of transformed arguments."
+ (declare (obsolete nil "28.1"))
(let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?")))
(eol-type (plist-get props 'eol-type))
properties tmp)
@@ -1175,106 +1153,6 @@ Value is a list of transformed arguments."
(error "unsupported XEmacs style make-coding-style arguments: %S"
`(,name ,type ,doc-string ,props))))))
-(defun make-coding-system (coding-system type mnemonic doc-string
- &optional
- flags
- properties
- eol-type)
- "Define a new coding system CODING-SYSTEM (symbol).
-This function is provided for backward compatibility."
- (declare (obsolete define-coding-system "23.1"))
- ;; For compatibility with XEmacs, we check the type of TYPE. If it
- ;; is a symbol, perhaps, this function is called with XEmacs-style
- ;; arguments. Here, try to transform that kind of arguments to
- ;; Emacs style.
- (if (symbolp type)
- (let ((args (transform-make-coding-system-args coding-system type
- mnemonic doc-string)))
- (setq coding-system (car args)
- type (nth 1 args)
- mnemonic (nth 2 args)
- doc-string (nth 3 args)
- flags (nth 4 args)
- properties (nth 5 args)
- eol-type (nth 6 args))))
-
- (setq type
- (cond ((eq type 0) 'emacs-mule)
- ((eq type 1) 'shift-jis)
- ((eq type 2) 'iso2022)
- ((eq type 3) 'big5)
- ((eq type 4) 'ccl)
- ((eq type 5) 'raw-text)
- (t
- (error "Invalid coding system type: %s" type))))
-
- (setq properties
- (let ((plist nil) key)
- (dolist (elt properties)
- (setq key (car elt))
- (cond ((eq key 'post-read-conversion)
- (setq key :post-read-conversion))
- ((eq key 'pre-write-conversion)
- (setq key :pre-write-conversion))
- ((eq key 'translation-table-for-decode)
- (setq key :decode-translation-table))
- ((eq key 'translation-table-for-encode)
- (setq key :encode-translation-table))
- ((eq key 'safe-charsets)
- (setq key :charset-list))
- ((eq key 'mime-charset)
- (setq key :mime-charset))
- ((eq key 'valid-codes)
- (setq key :valids)))
- (setq plist (plist-put plist key (cdr elt))))
- plist))
- (setq properties (plist-put properties :mnemonic mnemonic))
- (plist-put properties :coding-type type)
- (cond ((eq eol-type 0) (setq eol-type 'unix))
- ((eq eol-type 1) (setq eol-type 'dos))
- ((eq eol-type 2) (setq eol-type 'mac))
- ((vectorp eol-type) (setq eol-type nil)))
- (plist-put properties :eol-type eol-type)
-
- (cond
- ((eq type 'iso2022)
- (plist-put properties :flags
- (list (and (or (consp (nth 0 flags))
- (consp (nth 1 flags))
- (consp (nth 2 flags))
- (consp (nth 3 flags))) 'designation)
- (or (nth 4 flags) 'long-form)
- (and (nth 5 flags) 'ascii-at-eol)
- (and (nth 6 flags) 'ascii-at-cntl)
- (and (nth 7 flags) '7-bit)
- (and (nth 8 flags) 'locking-shift)
- (and (nth 9 flags) 'single-shift)
- (and (nth 10 flags) 'use-roman)
- (and (nth 11 flags) 'use-oldjis)
- (or (nth 12 flags) 'direction)
- (and (nth 13 flags) 'init-at-bol)
- (and (nth 14 flags) 'designate-at-bol)
- (and (nth 15 flags) 'safe)
- (and (nth 16 flags) 'latin-extra)))
- (plist-put properties :designation
- (let ((vec (make-vector 4 nil)))
- (dotimes (i 4)
- (let ((spec (nth i flags)))
- (if (eq spec t)
- (aset vec i '(94 96))
- (if (consp spec)
- (progn
- (if (memq t spec)
- (setq spec (append (delq t spec) '(94 96))))
- (aset vec i spec))))))
- vec)))
-
- ((eq type 'ccl)
- (plist-put properties :ccl-decoder (car flags))
- (plist-put properties :ccl-encoder (cdr flags))))
-
- (apply 'define-coding-system coding-system doc-string properties))
-
(defun merge-coding-systems (first second)
"Fill in any unspecified aspects of coding system FIRST from SECOND.
Return the resulting coding system."
@@ -1376,7 +1254,7 @@ Internal use only.")
(concat "\\(?:" completion-pcm--delim-wild-regex
"\\|\\([[:alpha:]]\\)[[:digit:]]\\)"))
(cs (completing-read
- (format "Coding system for saving file (default %s): " default)
+ (format-prompt "Coding system for saving file" default)
combined-table
nil t nil 'coding-system-history
(if default (symbol-name default)))))
@@ -1479,8 +1357,7 @@ graphical terminals."
default-terminal-coding-system)
default-terminal-coding-system)))
(read-coding-system
- (format "Coding system for terminal display (default %s): "
- default)
+ (format-prompt "Coding system for terminal display" default)
default))))
(if (and (not coding-system)
(not (terminal-coding-system)))
@@ -1513,8 +1390,7 @@ graphical terminals."
(default (if (eq (coding-system-type coding) 'raw-text)
default-keyboard-coding-system)))
(read-coding-system
- (format "Coding system for keyboard input (default %s): "
- default)
+ (format-prompt "Coding system for keyboard input" default)
default))))
(let ((coding-type (coding-system-type coding-system))
(saved-meta-mode
@@ -1609,10 +1485,8 @@ the text is encoded or decoded by CODING-SYSTEM."
This setting is effective for the next communication only."
(interactive
(list (read-coding-system
- (if last-next-selection-coding-system
- (format "Coding system for the next selection (default %S): "
- last-next-selection-coding-system)
- "Coding system for the next selection: ")
+ (format-prompt "Coding system for the next selection"
+ last-next-selection-coding-system)
last-next-selection-coding-system)))
(if coding-system
(setq last-next-selection-coding-system coding-system)
@@ -1621,15 +1495,6 @@ This setting is effective for the next communication only."
(setq next-selection-coding-system coding-system))
-(defun set-coding-priority (arg)
- "Set priority of coding categories according to ARG.
-ARG is a list of coding categories ordered by priority.
-
-This function is provided for backward compatibility."
- (declare (obsolete set-coding-system-priority "23.1"))
- (apply 'set-coding-system-priority
- (mapcar #'(lambda (x) (symbol-value x)) arg)))
-
;;; X selections
(defvar ctext-non-standard-encodings-alist
@@ -1852,8 +1717,8 @@ in-place."
;; self-extracting exe archives.
(mapcar (lambda (arg) (cons (purecopy (car arg)) (cdr arg)))
'(("\\.\\(\
-arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|\
-ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'"
+arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|squashfs\\|\
+ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\|SQUASHFS\\)\\'"
. no-conversion-multibyte)
("\\.\\(exe\\|EXE\\)\\'" . no-conversion)
("\\.\\(sx[dmicw]\\|odt\\|tar\\|t[bg]z\\)\\'" . no-conversion)
@@ -2308,8 +2173,7 @@ Part of the job of this function is setting `buffer-undo-list' appropriately."
(read-coding-system "Text was really in: ")
(let ((coding (or buffer-file-coding-system last-coding-system-used)))
(read-coding-system
- (concat "But was interpreted as"
- (if coding (format " (default %S): " coding) ": "))
+ (format-prompt "But was interpreted as" coding)
coding))))
(or (and new-coding coding)
(error "Coding system not specified"))
diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el
index 9ab9e3b0f65..37fcda70b37 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -300,9 +300,8 @@ The functions come in the following groups.
Store the name in the parameter-variable DEFAULT-NAME-VAR.
PROMPT is a string to be shown when the user is asked for a name."
(let ((encoding
- (completing-read
- (format "%s (default %s): " prompt (symbol-value default-name-var))
- ogonek-name-encoding-alist nil t)))
+ (completing-read (format-prompt prompt (symbol-value default-name-var))
+ ogonek-name-encoding-alist nil t)))
;; change the default name to the one just read, and
;; return the new default as the name you read
(set default-name-var
@@ -314,8 +313,7 @@ The result is stored in the variable DEFAULT-PREFIX-VAR.
PROMPT is a string to be shown when the user is asked for a new prefix."
(let ((prefix-string
(read-string
- (format "%s (default %s): " prompt
- (char-to-string (eval default-prefix-var))))))
+ (format-prompt prompt (char-to-string (eval default-prefix-var))))))
(if (> (length prefix-string) 1)
(error "! Only one character expected")
;; set the default prefix character to the one just read
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 63371bce4fb..e94b42230be 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -787,7 +787,7 @@ you type is correctly handled."
(defun quail-keyseq-translate (keyseq)
(apply 'string
- (mapcar (function (lambda (x) (quail-keyboard-translate x)))
+ (mapcar (lambda (x) (quail-keyboard-translate x))
keyseq)))
(defun quail-insert-kbd-layout (kbd-layout)
@@ -2146,7 +2146,7 @@ minibuffer and the selected frame has no other windows)."
(setq str
(format "%s[%s]"
str
- (concat (sort (mapcar (function (lambda (x) (car x)))
+ (concat (sort (mapcar (lambda (x) (car x))
(cdr map))
'<)))))
;; Show list of translations.
@@ -2350,13 +2350,13 @@ Optional 6th arg IGNORES is a list of translations to ignore."
((consp translation)
(setq translation (cdr translation))
(let ((multibyte nil))
- (mapc (function (lambda (x)
- ;; Accept only non-ASCII chars not
- ;; listed in IGNORES.
- (if (and (if (integerp x) (> x 127)
- (string-match-p "[^[:ascii:]]" x))
- (not (member x ignores)))
- (setq multibyte t))))
+ (mapc (lambda (x)
+ ;; Accept only non-ASCII chars not
+ ;; listed in IGNORES.
+ (if (and (if (integerp x) (> x 127)
+ (string-match-p "[^[:ascii:]]" x))
+ (not (member x ignores)))
+ (setq multibyte t)))
translation)
(when multibyte
(setcdr decode-map
@@ -2381,11 +2381,11 @@ These are stored in DECODE-MAP using the concise format. DECODE-MAP
should be made by `quail-build-decode-map' (which see)."
(setq decode-map
(sort (cdr decode-map)
- (function (lambda (x y)
- (setq x (car x) y (car y))
- (or (> (length x) (length y))
- (and (= (length x) (length y))
- (not (string< x y))))))))
+ (lambda (x y)
+ (setq x (car x) y (car y))
+ (or (> (length x) (length y))
+ (and (= (length x) (length y))
+ (not (string< x y)))))))
(let ((window-width (window-width (get-buffer-window
(current-buffer) 'visible)))
(single-trans-width 4)
diff --git a/lisp/international/rfc1843.el b/lisp/international/rfc1843.el
index 7f09eb41d17..c59538f5469 100644
--- a/lisp/international/rfc1843.el
+++ b/lisp/international/rfc1843.el
@@ -60,7 +60,7 @@ e-mail transmission, news posting, etc."
(defcustom rfc1843-newsgroups-regexp "chinese\\|hz"
"Regexp of newsgroups in which might be HZ encoded."
- :type 'string
+ :type 'regexp
:group 'mime)
(defun rfc1843-decode-region (from to)
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index 4f1bcf2f94e..2da8635f80b 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -1,4 +1,4 @@
-;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding: utf-8-emacs; lexical-binding:t -*-
+;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding:iso-2022-7bit; lexical-binding:t -*-
;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -83,9 +83,9 @@
;; how to select a translation from a list of candidates.
(defvar quail-cxterm-package-ext-info
- '(("chinese-4corner" "四角")
- ("chinese-array30" "3ï¼")
- ("chinese-ccdospy" "缩拼"
+ '(("chinese-4corner" "$(0(?-F(B")
+ ("chinese-array30" "$(0#R#O(B")
+ ("chinese-ccdospy" "$AKuF4(B"
"Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
Pinyin is the standard Roman transliteration method for Chinese.
@@ -94,10 +94,10 @@ method `chinese-py'.
This input method works almost the same way as `chinese-py'. The
difference is that you type a single key for these Pinyin spelling.
- Pinyin: zh en eng ang ch an ao ai ong sh ing yu(ü)
+ Pinyin: zh en eng ang ch an ao ai ong sh ing yu($A(9(B)
keyseq: a f g h i j k l s u y v
For example:
- Chinese: 啊 果 中 文 光 玉 全
+ Chinese: $A0!(B $A9{(B $AVP(B $AND(B $A9b(B $ASq(B $AH+(B
Pinyin: a guo zhong wen guang yu quan
Keyseq: a1 guo4 as1 wf4 guh1 yu..6 qvj6
@@ -106,14 +106,14 @@ For example:
For double-width GB2312 characters corresponding to ASCII, use the
input method `chinese-qj'.")
- ("chinese-ecdict" "英漢"
+ ("chinese-ecdict" "$(05CKH(B"
"In this input method, you enter a Chinese (Big5) character or word
by typing the corresponding English word. For example, if you type
-\"computer\", \"電腦\" is input.
+\"computer\", \"$(0IZH+(B\" is input.
\\<quail-translation-docstring>")
- ("chinese-etzy" "倚注"
+ ("chinese-etzy" "$(06/0D(B"
"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
`chinese-big5-2').
@@ -122,20 +122,20 @@ compose one Chinese character.
In this input method, you enter a Chinese character by first typing
keys corresponding to Zhuyin symbols (see the above table) followed by
-SPC, 1, 2, 3, or 4 specifying a tone (SPC:é™°å¹³, 1:輕è², 2:陽平, 3: 上è²,
-4:去è²).
+SPC, 1, 2, 3, or 4 specifying a tone (SPC:$(0?v(N(B, 1:$(0M=Vy(B, 2:$(0Dm(N(B, 3: $(0&9Vy(B,
+4:$(0(+Vy(B).
\\<quail-translation-docstring>")
- ("chinese-punct-b5" "標B"
+ ("chinese-punct-b5" "$(0O:(BB"
"Input method for Chinese punctuation and symbols of Big5
\(`chinese-big5-1' and `chinese-big5-2').")
- ("chinese-punct" "æ ‡G"
+ ("chinese-punct" "$A1j(BG"
"Input method for Chinese punctuation and symbols of GB2312
\(`chinese-gb2312').")
- ("chinese-py-b5" "拼B"
+ ("chinese-py-b5" "$(03<(BB"
"Pinyin base input method for Chinese Big5 characters
\(`chinese-big5-1', `chinese-big5-2').
@@ -153,28 +153,28 @@ method `chinese-qj-b5'.
The input method `chinese-py' and `chinese-tonepy' are also Pinyin
based, but for the character set GB2312 (`chinese-gb2312').")
- ("chinese-qj-b5" "å…¨B")
+ ("chinese-qj-b5" "$(0)A(BB")
- ("chinese-qj" "å…¨G")
+ ("chinese-qj" "$AH+(BG")
- ("chinese-sw" "首尾"
+ ("chinese-sw" "$AJWN2(B"
"Radical base input method for Chinese charset GB2312 (`chinese-gb2312').
In this input method, you enter a Chinese character by typing two
-keys. The first key corresponds to the first (首) radical, the second
-key corresponds to the last (å°¾) radical. The correspondence of keys
+keys. The first key corresponds to the first ($AJW(B) radical, the second
+key corresponds to the last ($AN2(B) radical. The correspondence of keys
and radicals is as below:
first radical:
a b c d e f g h i j k l m n o p q r s t u v w x y z
- 心 冖 å°¸ 丶 ç« å£ æ‰Œ æ°µ è®  艹 亻 木 礻 饣 月 纟 石 王 å…« 丿 æ—¥ è¾¶ 犭 竹 一 人
+ $APD(B $AZ"(B $AJ,(B $AX<(B $A;p(B $A?Z(B $A^P(B $Ac_(B $AZ%(B $A\3(B $AXi(B $AD>(B $Alj(B $Ab;(B $ATB(B $Afy(B $AJ/(B $AMu(B $A0K(B $AX/(B $AHU(B $AeA(B $Aak(B $AVq(B $AR;(B $AHK(B
last radical:
a b c d e f g h i j k l m n o p q r s t u v w x y z
- åˆ å±± 土 刀 é˜ å£ è¡£ ç–‹ 大 ä¸ åŽ¶ ç¬ å æ­¹ 冂 é—¨ 今 丨 女 ä¹™ å›— å° åŽ‚ 虫 弋 åœ
+ $ASV(B $AI=(B $AMA(B $A56(B $AZb(B $A?Z(B $ARB(B $Aqb(B $A4s(B $A6!(B $A[L(B $Ala(B $AJ.(B $A4u(B $AXg(B $ACE(B $A=q(B $AX-(B $AE.(B $ARR(B $A`m(B $AP!(B $A3'(B $A3f(B $A_.(B $A27(B
\\<quail-translation-docstring>")
- ("chinese-tonepy" "调拼"
+ ("chinese-tonepy" "$A5wF4(B"
"Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
Pinyin is the standard roman transliteration method for Chinese.
@@ -183,18 +183,18 @@ method `chinese-py'.
This input method works almost the same way as `chinese-py'. The
difference is that you must type 1..5 after each Pinyin spelling to
-specify a tone (1:阴平, 2:阳平, 3:上声, 4下声, 5:轻声).
+specify a tone (1:$ARuF=(B, 2:$AQtF=(B, 3:$AIOIy(B, 4$AOBIy(B, 5:$AGaIy(B).
\\<quail-translation-docstring>
-For instance, to input ä½ , you type \"n i 3 3\", the first \"n i\" is
+For instance, to input $ADc(B, you type \"n i 3 3\", the first \"n i\" is
a Pinyin, the next \"3\" specifies tone, and the last \"3\" selects
the third character from the candidate list.
For double-width GB2312 characters corresponding to ASCII, use the
input method `chinese-qj'.")
- ("chinese-zozy" "零注"
+ ("chinese-zozy" "$(0I\0D(B"
"Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1',
`chinese-big5-2').
@@ -203,8 +203,8 @@ compose a Chinese character.
In this input method, you enter a Chinese character by first typing
keys corresponding to Zhuyin symbols (see the above table) followed by
-SPC, 6, 3, 4, or 7 specifying a tone (SPC:é™°å¹³, 6:陽平, 3:上è², 4:去è²,
-7:輕è²).
+SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy(B, 4:$(0(+Vy(B,
+7:$(0M=Vy(B).
\\<quail-translation-docstring>")))
@@ -354,7 +354,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:é™°å¹³, 6:陽平, 3:上è², 4:去è²,
(princ (nth 2 (assoc tit-encode tit-encode-list)))
(princ "\" \"")
(princ (or title
- (if (string-match "[:∷:ã€]+\\([^:∷:】]+\\)" tit-prompt)
+ (if (string-match "[:$A!K$(0!(!J(B]+\\([^:$A!K$(0!(!K(B]+\\)" tit-prompt)
(substring tit-prompt (match-beginning 1) (match-end 1))
tit-prompt)))
(princ "\"\n"))
@@ -580,7 +580,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; )
(defvar quail-misc-package-ext-info
- '(("chinese-b5-tsangchi" "倉B"
+ '(("chinese-b5-tsangchi" "$(06A(BB"
"cangjie-table.b5" big5 "tsang-b5.el"
tsang-b5-converter
"\
@@ -590,7 +590,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-b5-quick" "ç°¡B"
+ ("chinese-b5-quick" "$(0X|(BB"
"cangjie-table.b5" big5 "quick-b5.el"
quick-b5-converter
"\
@@ -600,7 +600,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-cns-tsangchi" "倉C"
+ ("chinese-cns-tsangchi" "$(GT?(BC"
"cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el"
tsang-cns-converter
"\
@@ -610,7 +610,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-cns-quick" "ç°¡C"
+ ("chinese-cns-quick" "$(Gv|(BC"
"cangjie-table.cns" iso-2022-cn-ext "quick-cns.el"
quick-cns-converter
"\
@@ -620,7 +620,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # unmodified versions is granted without royalty provided
;; # this notice is preserved.")
- ("chinese-py" "拼G"
+ ("chinese-py" "$AF4(BG"
"pinyin.map" cn-gb-2312 "PY.el"
py-converter
"\
@@ -648,7 +648,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; You should have received a copy of the GNU General Public License along with
;; CCE. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ziranma" "自然"
+ ("chinese-ziranma" "$AWTH;(B"
"ziranma.cin" cn-gb-2312 "ZIRANMA.el"
ziranma-converter
"\
@@ -676,7 +676,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; You should have received a copy of the GNU General Public License along with
;; CCE. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ctlau" "刘粤"
+ ("chinese-ctlau" "$AAuTA(B"
"CTLau.html" cn-gb-2312 "CTLau.el"
ctlau-gb-converter
"\
@@ -701,7 +701,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # You should have received a copy of the GNU General Public License
;; # along with this program. If not, see <https://www.gnu.org/licenses/>.")
- ("chinese-ctlaub" "劉粵"
+ ("chinese-ctlaub" "$(0N,Gn(B"
"CTLau-b5.html" big5 "CTLau-b5.el"
ctlau-b5-converter
"\
@@ -731,38 +731,38 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; dictionary in the buffer DICBUF. The input method name of the
;; Quail package is NAME, and the title string is TITLE.
-;; TSANG-P is non-nil, generate 倉頡 input method. Otherwise
-;; generate 簡易 (simple version of 倉頡). If BIG5-P is non-nil, the
+;; TSANG-P is non-nil, generate $(06AQo(B input method. Otherwise
+;; generate $(0X|/y(B (simple version of $(06AQo(B). If BIG5-P is non-nil, the
;; input method is for inputting Big5 characters. Otherwise the input
;; method is for inputting CNS characters.
(defun tsang-quick-converter (dicbuf tsang-p big5-p)
- (let ((fulltitle (if tsang-p (if big5-p "倉頡" "倉頡")
- (if big5-p "簡易" "簡易")))
+ (let ((fulltitle (if tsang-p (if big5-p "$(06AQo(B" "$(GT?on(B")
+ (if big5-p "$(0X|/y(B" "$(Gv|Mx(B")))
dic)
(goto-char (point-max))
(if big5-p
- (insert (format "\"中文輸入ã€%s】BIG5
+ (insert (format "\"$(0&d'GTT&,!J(B%s$(0!K(BBIG5
- 漢語%s輸入éµç›¤
+ $(0KHM$(B%s$(0TT&,WoOu(B
- [Q 手] [W ç”°] [E æ°´] [R å£] [T 廿] [Y åœ] [U å±±] [I 戈] [O 人] [P 心]
+ [Q $(0'D(B] [W $(0(q(B] [E $(0'V(B] [R $(0&H(B] [T $(0'>(B] [Y $(0&4(B] [U $(0&U(B] [I $(0'B(B] [O $(0&*(B] [P $(0'A(B]
- [A æ—¥] [S å°¸] [D 木] [F ç«] [G 土] [H 竹] [J å] [L 中]
+ [A $(0'K(B] [S $(0&T(B] [D $(0'N(B] [F $(0'W(B] [G $(0&I(B] [H $(0*M(B] [J $(0&3(B] [L $(0&d(B]
- [Z ] [X 難] [C 金] [V 女] [B 月] [N 弓] [M 一]
+ [Z ] [X $(0[E(B] [C $(01[(B] [V $(0&M(B] [B $(0'M(B] [N $(0&_(B] [M $(0&"(B]
\\\\<quail-translation-docstring>\"\n"
fulltitle fulltitle))
- (insert (format "\"中文輸入ã€%s】CNS
+ (insert (format "\"$(GDcEFrSD+!J(B%s$(G!K(BCNS
- 漢語%s輸入éµç›¤
+ $(GiGk#(B%s$(GrSD+uomu(B
- [Q 手] [W ç”°] [E æ°´] [R å£] [T 廿] [Y åœ] [U å±±] [I 戈] [O 人] [P 心]
+ [Q $(GEC(B] [W $(GFp(B] [E $(GEU(B] [R $(GDG(B] [T $(GE=(B] [Y $(GD3(B] [U $(GDT(B] [I $(GEA(B] [O $(GD)(B] [P $(GE@(B]
- [A æ—¥] [S å°¸] [D 木] [F ç«] [G 土] [H 竹] [J å] [L 中]
+ [A $(GEJ(B] [S $(GDS(B] [D $(GEM(B] [F $(GEV(B] [G $(GDH(B] [H $(GHL(B] [J $(GD2(B] [L $(GDc(B]
- [Z ] [X 難] [C 金] [V 女] [B 月] [N 弓] [M 一]
+ [Z ] [X $(GyE(B] [C $(GOZ(B] [V $(GDL(B] [B $(GEL(B] [N $(GD^(B] [M $(GD!(B]
\\\\<quail-translation-docstring>\"\n"
fulltitle fulltitle)))
@@ -795,38 +795,38 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(forward-line 1)))
(maphash #'(lambda (key val) (setq dic (cons (cons key val) dic)))
table)))
- (setq dic (sort dic (function (lambda (x y) (string< (car x ) (car y))))))
+ (setq dic (sort dic (lambda (x y) (string< (car x ) (car y)))))
(dolist (elt dic)
(insert (format "(%S\t%S)\n" (car elt) (cdr elt))))
- (let ((punctuation '((";" ";﹔,ã€ï¹ï¹‘" ";﹔,ã€ï¹ï¹‘")
- (":" ":︰﹕.。‧﹒·" ":︰﹕.。・﹒·")
- ("'" "’‘" "’‘")
- ("\"" "â€â€œã€ã€žã€ƒ" "â€â€œã€ã€žã€ƒ")
- ("\\" "\﹨╲" "\﹨╲")
- ("|" "|︱︳∣" "︱︲ô”€™ï½œ")
- ("/" "ï¼âˆ•╱" "ï¼âˆ•╱")
- ("?" "?﹖" "?﹖")
- ("<" "〈<﹤︿∠" "〈<﹤︿∠")
- (">" "〉>﹥﹀" "〉>﹦﹀")
- ("[" "〔ã€ï¹ï¸¹ï¸»ã€Œã€Žï¹ï¹ƒ" "〔ã€ï¹ï¸¹ï¸»ã€Œã€Žï¹ï¹ƒ")
- ("]" "〕】﹞︺︼ã€ã€ï¹‚﹄" "〕】﹞︺︼ã€ã€ï¹‚﹄")
- ("{" "{﹛︷ " "{﹛︷ ")
- ("}" "ï½ï¹œï¸¸" "ï½ï¹œï¸¸")
- ("`" "‵′" "′‵")
- ("~" "~﹋﹌︴ï¹" "∼﹋﹌ô”€›ô”€œ")
- ("!" "ï¼ï¹—" "ï¼ï¹—")
- ("@" "@﹫" "@﹫")
- ("#" "#﹟" "#﹟")
- ("$" "$﹩" "$﹩")
- ("%" "%﹪" "%﹪")
- ("&" "&﹠" "&﹠")
- ("*" "*﹡※☆★" "*﹡※☆★")
- ("(" "(﹙︵" "(﹙︵")
- (")" ")﹚︶" ")﹚︶")
- ("-" "–—¯ ̄ï¼ï¹£" "—–‾ô”¡ï¼ï¹£")
- ("_" "_Ë" "_ô”£")
- ("=" "ï¼ï¹¦" "ï¼ï¹¥")
- ("+" "+﹢" "+﹢"))))
+ (let ((punctuation '((";" "$(0!'!2!"!#!.!/(B" "$(G!'!2!"!#!.!/(B")
+ (":" "$(0!(!+!3!%!$!&!0!1(B" "$(G!(!+!3!%!$!&!0!1(B")
+ ("'" "$(0!e!d(B" "$(G!e!d(B")
+ ("\"" "$(0!g!f!h!i!q(B" "$(G!g!f!h!i!q(B")
+ ("\\" "$(0"`"b#M(B" "$(G"`"b#M(B")
+ ("|" "$(0!6!8!:"^(B" "$(G!6!8!:"^(B")
+ ("/" "$(0"_"a#L(B" "$(G"_"a#L(B")
+ ("?" "$(0!)!4(B" "$(G!)!4(B")
+ ("<" "$(0!R"6"A!T"H(B" "$(G!R"6"A!T"H(B")
+ (">" "$(0!S"7"B!U(B" "$(G!S"7"B!U(B")
+ ("[" "$(0!F!J!b!H!L!V!Z!X!\(B" "$(G!F!J!b!H!L!V!Z!X!\(B")
+ ("]" "$(0!G!K!c!I!M!W![!Y!](B" "$(G!G!K!c!I!M!W![!Y!](B")
+ ("{" "$(0!B!`!D(B " "$(G!B!`!D(B ")
+ ("}" "$(0!C!a!E(B" "$(G!C!a!E(B")
+ ("`" "$(0!j!k(B" "$(G!j!k(B")
+ ("~" "$(0"D"+",!<!=(B" "$(G"D"+",!<!=(B")
+ ("!" "$(0!*!5(B" "$(G!*!5(B")
+ ("@" "$(0"i"n(B" "$(G"i"n(B")
+ ("#" "$(0!l"-(B" "$(G!l"-(B")
+ ("$" "$(0"c"l(B" "$(G"c"l(B")
+ ("%" "$(0"h"m(B" "$(G"h"m(B")
+ ("&" "$(0!m".(B" "$(G!m".(B")
+ ("*" "$(0!n"/!o!w!x(B" "$(G!n"/!o!w!x(B")
+ ("(" "$(0!>!^!@(B" "$(G!>!^!@(B")
+ (")" "$(0!?!_!A(B" "$(G!?!_!A(B")
+ ("-" "$(0!7!9"#"$"1"@(B" "$(G!7!9"#"$"1"@(B")
+ ("_" "$(0"%"&(B" "$(G"%"&(B")
+ ("=" "$(0"8"C(B" "$(G"8"C(B")
+ ("+" "$(0"0"?(B" "$(G"0"?(B"))))
(dolist (elt punctuation)
(insert (format "(%S %S)\n" (concat "z" (car elt))
(if big5-p (nth 1 elt) (nth 2 elt))))))
@@ -850,11 +850,11 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(defun py-converter (dicbuf)
(goto-char (point-max))
- (insert (format "%S\n" "汉字输入∷拼音∷
+ (insert (format "%S\n" "$A::WVJdHk!KF4Rt!K(B
- 拼音方案
+ $AF4Rt7=08(B
- å°å†™è‹±æ–‡å­—æ¯ä»£è¡¨ã€Œæ‹¼éŸ³ã€ç¬¦å·ï¼Œ \"u(yu) 则用 u: 表示∶
+ $AP!P4S"NDWVD84z1m!8F4Rt!97{:E#,(B \"u(yu) $ATrSC(B u: $A1mJ>!C(B
Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312').
@@ -868,14 +868,14 @@ character. The sequence is made by the combination of the initials
iang ing iong u ua uo uai ui uan un uan ueng yu yue yuan yun
(Note: In the correct Pinyin writing, the sequence \"yu\" in the last
- four finals should be written by the character u-umlaut `ü'.)
+ four finals should be written by the character u-umlaut `$A(9(B'.)
With this input method, you enter a Chinese character by first
entering its pinyin spelling.
\\<quail-translation-docstring>
-For instance, to input ä½ , you type \"n i C-n 3\". The first \"n i\"
+For instance, to input $ADc(B, you type \"n i C-n 3\". The first \"n i\"
is a Pinyin, \"C-n\" selects the next group of candidates (each group
contains at most 10 characters), \"3\" select the third character in
that group.
@@ -956,24 +956,24 @@ method `chinese-tonepy' with which you must specify tones by digits
(setq trans (mapconcat 'identity trans "")))))
(setq dic (cons (cons key trans) dic)))
table)))
- (setq dic (sort dic (function (lambda (x y) (string< (car x) (car y))))))
+ (setq dic (sort dic (lambda (x y) (string< (car x) (car y)))))
(goto-char (point-max))
- (insert (format "%S\n" "汉字输入∷ã€è‡ªç„¶ã€‘∷
-
- 键盘对照表:
- â”â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┓
- ┃Q ┃W ┃E ┃R ┃T ┃Y ┃Ush┃Ich┃O ┃P ┃
- ┃ iu┃ ua┃ e┃ uan┃ ue┃ uai┃ u┃ i┃ o┃ un┃
- ┃ ┃ ia┃ ┃ van┃ ve┃ ing┃ ┃ ┃ uo┃ vn┃
- ┗┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”â”›
- ┃A ┃S ┃D ┃F ┃G ┃H ┃J ┃K ┃L ┃
- ┃ a┃iong┃uang┃ en┃ eng┃ ang┃ an┃ ao┃ ai┃
- ┃ ┃ ong┃iang┃ ┃ ng┃ ┃ ┃ ┃ ┃
- ┗┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”â”┓
- ┃Z ┃X ┃C ┃Vzh┃B ┃N ┃M ┃, ┃. ┃ ï¼ â”ƒ
- ┃ ei┃ ie┃ iao┃ ui┃ ou┃ in┃ ian┃å‰é¡µâ”ƒåŽé¡µâ”ƒç¬¦å·â”ƒ
- ┃ ┃ ┃ ┃ v┃ ┃ ┃ ┃ ┃ ┃ ┃
- â”—â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”›
+ (insert (format "%S\n" "$A::WVJdHk!K!>WTH;!?!K(B
+
+ $A<|EL6TUU1m(B:
+ $A)3)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)7(B
+ $A)'#Q(B $A)'#W(B $A)'#E(B $A)'#R(B $A)'#T(B $A)'#Y(B $A)'#U(Bsh$A)'#I(Bch$A)'#O(B $A)'#P(B $A)'(B
+ $A)'(B iu$A)'(B ua$A)'(B e$A)'(B uan$A)'(B ue$A)'(B uai$A)'(B u$A)'(B i$A)'(B o$A)'(B un$A)'(B
+ $A)'(B $A)'(B ia$A)'(B $A)'(B van$A)'(B ve$A)'(B ing$A)'(B $A)'(B $A)'(B uo$A)'(B vn$A)'(B
+ $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)?(B
+ $A)'#A(B $A)'#S(B $A)'#D(B $A)'#F(B $A)'#G(B $A)'#H(B $A)'#J(B $A)'#K(B $A)'#L(B $A)'(B
+ $A)'(B a$A)'(Biong$A)'(Buang$A)'(B en$A)'(B eng$A)'(B ang$A)'(B an$A)'(B ao$A)'(B ai$A)'(B
+ $A)'(B $A)'(B ong$A)'(Biang$A)'(B $A)'(B ng$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B
+ $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)%)7(B
+ $A)'#Z(B $A)'#X(B $A)'#C(B $A)'#V(Bzh$A)'#B(B $A)'#N(B $A)'#M(B $A)'#,(B $A)'#.(B $A)'(B $A#/(B $A)'(B
+ $A)'(B ei$A)'(B ie$A)'(B iao$A)'(B ui$A)'(B ou$A)'(B in$A)'(B ian$A)'G0R3)':sR3)'7{:E)'(B
+ $A)'(B $A)'(B $A)'(B $A)'(B v$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B
+ $A);)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)?(B
Pinyin base input method for Chinese GB2312 characters (`chinese-gb2312').
@@ -985,34 +985,34 @@ method `chinese-py'.
Unlike the standard spelling of Pinyin, in this input method all
initials and finals are assigned to single keys (see the above table).
For instance, the initial \"ch\" is assigned to the key `i', the final
-\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and 轻声 are
+\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and $AGaIy(B are
assigned to the keys `q', `w', `e', `r', `t' respectively.
\\<quail-translation-docstring>
To input one-letter words, you type 4 keys, the first two for the
Pinyin of the letter, next one for tone, and the last one is always a
-quote ('). For instance, \"vsq'\" input 中. Exceptions are these
+quote ('). For instance, \"vsq'\" input $AVP(B. Exceptions are these
letters. You can input them just by typing a single key.
- Character: 按 ä¸ æ¬¡ çš„ 二 å‘ ä¸ª å’Œ 出 åŠ å¯ äº† 没
+ Character: $A04(B $A2;(B $A4N(B $A5D(B $A6~(B $A7"(B $A8v(B $A:M(B $A3v(B $A<0(B $A?I(B $AAK(B $AC;(B
Key: a b c d e f g h i j k l m
- Character: ä½  欧 片 七 人 三 ä»– 是 ç€ æˆ‘ å° ä¸€ 在
+ Character: $ADc(B $AE7(B $AF,(B $AF_(B $AHK(B $AH}(B $AK{(B $AJG(B $AWE(B $ANR(B $AP!(B $AR;(B $ATZ(B
Key: n o p q r s t u v w x y z
To input two-letter words, you have two ways. One way is to type 4
keys, two for the first Pinyin, two for the second Pinyin. For
-instance, \"vsgo\" inputs 中国. Another way is to type 3 keys: 2
+instance, \"vsgo\" inputs $AVP9z(B. Another way is to type 3 keys: 2
initials of two letters, and quote ('). For instance, \"vg'\" also
-inputs 中国.
+inputs $AVP9z(B.
To input three-letter words, you type 4 keys: initials of three
-letters, and the last is quote ('). For instance, \"bjy'2\" inputs 北
-京鸭 (the last `2' is to select one of the candidates).
+letters, and the last is quote ('). For instance, \"bjy'2\" inputs $A11(B
+$A>)Q<(B (the last `2' is to select one of the candidates).
To input words of more than three letters, you type 4 keys, initials
of the first three letters and the last letter. For instance,
-\"bjdt\" inputs 北京电视å°.
+\"bjdt\" inputs $A11>)5gJSL((B.
To input symbols and punctuation, type `/' followed by one of `a' to
`z', then select one of the candidates."))
@@ -1059,7 +1059,7 @@ To input symbols and punctuation, type `/' followed by one of `a' to
;; which the file is converted have no Big5 equivalent. Go
;; through and delete them.
(goto-char pos)
- (while (search-forward "â–¡" nil t)
+ (while (search-forward "$(0!{(B" nil t)
(delete-char -1))
;; Uppercase keys in dictionary need to be downcased. Backslashes
;; at the beginning of keys need to be turned into double
@@ -1083,31 +1083,31 @@ To input symbols and punctuation, type `/' followed by one of `a' to
(defun ctlau-gb-converter (dicbuf)
(ctlau-converter dicbuf
-"汉字输入∷刘锡祥å¼ç²¤éŸ³âˆ·
+"$A::WVJdHk!KAuN}OiJ=TARt!K(B
- 刘锡祥å¼ç²¤è¯­æ³¨éŸ³æ–¹æ¡ˆ
+ $AAuN}OiJ=TASoW"Rt7=08(B
Sidney Lau's Cantonese transcription scheme as described in his book
\"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
- This file was prepared by Fung Fung Lee (æŽæž«å³°).
+ This file was prepared by Fung Fung Lee ($A@n7c7e(B).
Originally converted from CTCPS3.tit
Last modified: June 2, 1993.
Some infrequent GB characters are accessed by typing \\, followed by
- the Cantonese romanization of the respective radical (部首)."))
+ the Cantonese romanization of the respective radical ($A2?JW(B)."))
(defun ctlau-b5-converter (dicbuf)
(ctlau-converter dicbuf
-"漢字輸入:劉錫祥å¼ç²µéŸ³ï¼š
+"$(0KH)tTT&,!(N,Tg>A*#Gn5x!((B
- 劉錫祥å¼ç²µèªžæ³¨éŸ³æ–¹æ¡ˆ
+ $(0N,Tg>A*#GnM$0D5x'J7{(B
Sidney Lau's Cantonese transcription scheme as described in his book
\"Elementary Cantonese\", The Government Printer, Hong Kong, 1972.
- This file was prepared by Fung Fung Lee (æŽæ¥“å³°).
+ This file was prepared by Fung Fung Lee ($(0,XFS76(B).
Originally converted from CTCPS3.tit
Last modified: June 2, 1993.
Some infrequent characters are accessed by typing \\, followed by
- the Cantonese romanization of the respective radical (部首)."))
+ the Cantonese romanization of the respective radical ($(0?f5}(B)."))
(declare-function dos-8+3-filename "dos-fns.el" (filename))
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index 201ff6b9b17..7822450e49b 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -25,8 +25,8 @@
;; This program has passed the NormalizationTest-5.2.0.txt.
;;
;; References:
-;; http://www.unicode.org/reports/tr15/
-;; http://www.unicode.org/review/pr-29.html
+;; https://www.unicode.org/reports/tr15/
+;; https://www.unicode.org/review/pr-29.html
;;
;; HFS-Normalization:
;; Reference:
@@ -98,7 +98,7 @@
;;
;; D. Sorting and Composition of Smaller Blocks (`ucs-normalize-block-compose-chars')
;;
-;; The block will be split to multiple samller blocks by starter
+;; The block will be split to multiple smaller blocks by starter
;; characters. Each block is sorted, and composed if necessary.
;;
;; E. Composition of Entire Block (`ucs-normalize-compose-chars')
@@ -131,7 +131,7 @@
#x1D1BF #x1D1C0)
"Composition Exclusion List.
This list is taken from
- http://www.unicode.org/Public/UNIDATA/5.2/CompositionExclusions.txt")
+ https://www.unicode.org/Public/UNIDATA/5.2/CompositionExclusions.txt")
;; Unicode ranges that decompositions & combining characters are defined.
(defvar check-range nil)
@@ -441,7 +441,7 @@ decomposition."
(concat (quick-check-list-to-regexp quick-check-list) "\\|[가-힣]"))
(defun quick-check-composition-list-to-regexp (quick-check-list)
- (concat (quick-check-list-to-regexp quick-check-list) "\\|[ᅡ-ᅵᆨ-ᇂ]"))
+ (quick-check-list-to-regexp quick-check-list))
)
@@ -612,14 +612,16 @@ COMPOSITION-PREDICATE will be used to compose region."
(defun ucs-normalize-hfs-nfd-post-read-conversion (len)
(save-excursion
(save-restriction
- (narrow-to-region (point) (+ (point) len))
- (ucs-normalize-HFS-NFC-region (point-min) (point-max))
- (- (point-max) (point-min)))))
+ (save-match-data
+ (narrow-to-region (point) (+ (point) len))
+ (ucs-normalize-HFS-NFC-region (point-min) (point-max))
+ (- (point-max) (point-min))))))
;; Pre-write conversion for `utf-8-hfs'.
;; _from and _to are legacy arguments (see `define-coding-system').
(defun ucs-normalize-hfs-nfd-pre-write-conversion (_from _to)
- (ucs-normalize-HFS-NFD-region (point-min) (point-max)))
+ (save-match-data
+ (ucs-normalize-HFS-NFD-region (point-min) (point-max))))
;;; coding-system definition
(define-coding-system 'utf-8-hfs
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 57b13a38d67..4fba4370d98 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -54,7 +54,6 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-(declare-function tmm-menubar-keymap "tmm.el")
;; Some additional options and constants.
@@ -269,6 +268,17 @@ are `word-search-regexp' \(`\\[isearch-toggle-word]'), `isearch-symbol-regexp'
"Non-nil means incremental search highlights the current match."
:type 'boolean)
+(defcustom search-highlight-submatches t
+ "Whether to highlight regexp subexpressions of the current regexp match.
+The faces used to do the highlights are named `isearch-group-1',
+`isearch-group-2', etc. (By default, only these 2 are defined.)
+When there are more matches than faces, then faces are reused from the
+beginning, in a cyclical manner, so the `isearch-group-1' face is
+isreused for the third match. If you want to use more distinctive colors,
+you can define more of these faces using the same numbering scheme."
+ :type 'boolean
+ :version "28.1")
+
(defface isearch
'((((class color) (min-colors 88) (background light))
;; The background must not be too dark, for that means
@@ -494,7 +504,7 @@ This is like `describe-bindings', but displays only Isearch keys."
(require 'tmm)
(run-hooks 'menu-bar-update-hook)
(let ((command nil))
- (let ((menu-bar (tmm-menubar-keymap)))
+ (let ((menu-bar (menu-bar-keymap)))
(with-isearch-suspended
(setq command (let ((isearch-mode t)) ; Show bindings from
; `isearch-mode-map' in
@@ -555,6 +565,10 @@ This is like `describe-bindings', but displays only Isearch keys."
:help "Highlight all matches for current search string"))
(define-key map [isearch-search-replace-separator]
'(menu-item "--"))
+ (define-key map [isearch-transient-input-method]
+ '(menu-item "Turn on transient input method"
+ isearch-transient-input-method
+ :help "Turn on transient input method for search"))
(define-key map [isearch-toggle-specified-input-method]
'(menu-item "Turn on specific input method"
isearch-toggle-specified-input-method
@@ -737,6 +751,7 @@ This is like `describe-bindings', but displays only Isearch keys."
;; For searching multilingual text.
(define-key map "\C-\\" 'isearch-toggle-input-method)
(define-key map "\C-^" 'isearch-toggle-specified-input-method)
+ (define-key map "\C-x\\" 'isearch-transient-input-method)
;; People expect to be able to paste with the mouse.
(define-key map [mouse-2] #'isearch-mouse-2)
@@ -880,7 +895,7 @@ variable by the command `isearch-toggle-lax-whitespace'.")
"Stack of search status elements.
Each element is an `isearch--state' struct where the slots are
[STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD/REGEXP-FUNCTION
- ERROR WRAPPED BARRIER CASE-FOLD-SEARCH POP-FUN]")
+ ERROR WRAPPED BARRIER CASE-FOLD-SEARCH POP-FUN MATCH-DATA]")
(defvar isearch-string "") ; The current search string.
(defvar isearch-message "") ; text-char-description version of isearch-string
@@ -896,6 +911,7 @@ Each element is an `isearch--state' struct where the slots are
"Recorded minimum/maximal point for the current search.")
(defvar isearch-just-started nil)
(defvar isearch-start-hscroll 0) ; hscroll when starting the search.
+(defvar isearch-match-data nil) ; match-data of regexp-based search
;; case-fold-search while searching.
;; either nil, t, or 'yes. 'yes means the same as t except that mixed
@@ -1067,6 +1083,8 @@ To use a different input method for searching, type \
\\[isearch-toggle-specified-input-method],
and specify an input method you want to use.
+To activate a transient input method, type \\[isearch-transient-input-method].
+
The above keys, bound in `isearch-mode-map', are often controlled by
options; do \\[apropos] on search-.* to find them.
Other control and meta characters terminate the search
@@ -1214,6 +1232,7 @@ used to set the value of `isearch-regexp-function'."
isearch-small-window nil
isearch-just-started t
isearch-start-hscroll (window-hscroll)
+ isearch-match-data nil
isearch-opoint (point)
search-ring-yank-pointer nil
@@ -1342,8 +1361,8 @@ The last thing is to trigger a new round of lazy highlighting."
(set-window-hscroll (selected-window) current-scroll))))
(if isearch-other-end
(if (< isearch-other-end (point)) ; isearch-forward?
- (isearch-highlight isearch-other-end (point))
- (isearch-highlight (point) isearch-other-end))
+ (isearch-highlight isearch-other-end (point) isearch-match-data)
+ (isearch-highlight (point) isearch-other-end isearch-match-data))
(isearch-dehighlight))))
(setq ;; quit-flag nil not for isearch-mode
isearch-adjusted nil
@@ -1501,7 +1520,8 @@ REGEXP if non-nil says use the regexp search ring."
(barrier isearch-barrier)
(case-fold-search isearch-case-fold-search)
(pop-fun (if isearch-push-state-function
- (funcall isearch-push-state-function))))))
+ (funcall isearch-push-state-function)))
+ (match-data isearch-match-data))))
(string nil :read-only t)
(message nil :read-only t)
(point nil :read-only t)
@@ -1513,7 +1533,8 @@ REGEXP if non-nil says use the regexp search ring."
(wrapped nil :read-only t)
(barrier nil :read-only t)
(case-fold-search nil :read-only t)
- (pop-fun nil :read-only t))
+ (pop-fun nil :read-only t)
+ (match-data nil :read-only t))
(defun isearch--set-state (cmd)
(setq isearch-string (isearch--state-string cmd)
@@ -1525,7 +1546,8 @@ REGEXP if non-nil says use the regexp search ring."
isearch-error (isearch--state-error cmd)
isearch-wrapped (isearch--state-wrapped cmd)
isearch-barrier (isearch--state-barrier cmd)
- isearch-case-fold-search (isearch--state-case-fold-search cmd))
+ isearch-case-fold-search (isearch--state-case-fold-search cmd)
+ isearch-match-data (isearch--state-match-data cmd))
(if (functionp (isearch--state-pop-fun cmd))
(funcall (isearch--state-pop-fun cmd) cmd))
(goto-char (isearch--state-point cmd)))
@@ -1617,6 +1639,7 @@ You can update the global isearch variables by setting new values to
(isearch-adjusted isearch-adjusted)
(isearch-yank-flag isearch-yank-flag)
(isearch-error isearch-error)
+ (isearch-match-data isearch-match-data)
(multi-isearch-file-list-new multi-isearch-file-list)
(multi-isearch-buffer-list-new multi-isearch-buffer-list)
@@ -2011,15 +2034,16 @@ Turning on character-folding turns off regexp mode.")
(defvar isearch-message-properties minibuffer-prompt-properties
"Text properties that are added to the isearch prompt.")
-(defun isearch--momentary-message (string)
- "Print STRING at the end of the isearch prompt for 1 second."
+(defun isearch--momentary-message (string &optional seconds)
+ "Print STRING at the end of the isearch prompt for 1 second.
+The optional argument SECONDS overrides the number of seconds."
(let ((message-log-max nil))
(message "%s%s%s"
(isearch-message-prefix nil isearch-nonincremental)
isearch-message
(apply #'propertize (format " [%s]" string)
isearch-message-properties)))
- (sit-for 1))
+ (sit-for (or seconds 1)))
(isearch-define-mode-toggle lax-whitespace " " nil
"In ordinary search, toggles the value of the variable
@@ -2336,7 +2360,7 @@ characters in that string."
(with-isearch-suspended
(setq regexp-collect
(read-regexp
- (format "Regexp to collect (default %s): " default)
+ (format-prompt "Regexp to collect" default)
default 'occur-collect-regexp-history)))
regexp-collect))
;; Otherwise normal occur takes numerical prefix argument.
@@ -2381,22 +2405,17 @@ respectively)."
(funcall isearch-regexp-function isearch-string))
(isearch-regexp-function (word-search-regexp isearch-string))
(isearch-regexp isearch-string)
- ((if (and (eq isearch-case-fold-search t)
- search-upper-case)
- (isearch-no-upper-case-p
- isearch-string isearch-regexp)
- isearch-case-fold-search)
- ;; Turn isearch-string into a case-insensitive
- ;; regexp.
- (mapconcat
- (lambda (c)
- (let ((s (string c)))
- (if (string-match "[[:alpha:]]" s)
- (format "[%s%s]" (upcase s) (downcase s))
- (regexp-quote s))))
- isearch-string ""))
(t (regexp-quote isearch-string)))))
- (funcall hi-lock-func regexp (hi-lock-read-face-name)))
+ (let ((case-fold-search isearch-case-fold-search)
+ ;; Set `search-upper-case' to nil to not call
+ ;; `isearch-no-upper-case-p' in `hi-lock'.
+ (search-upper-case nil)
+ (search-spaces-regexp
+ (if (if isearch-regexp
+ isearch-regexp-lax-whitespace
+ isearch-lax-whitespace)
+ search-whitespace-regexp)))
+ (funcall hi-lock-func regexp (hi-lock-read-face-name) isearch-string)))
(and isearch-recursive-edit (exit-recursive-edit)))
(defun isearch-highlight-regexp ()
@@ -2404,14 +2423,18 @@ respectively)."
The arguments passed to `highlight-regexp' are the regexp from
the last search and the face from `hi-lock-read-face-name'."
(interactive)
- (isearch--highlight-regexp-or-lines 'highlight-regexp))
+ (isearch--highlight-regexp-or-lines
+ #'(lambda (regexp face lighter)
+ (highlight-regexp regexp face nil lighter))))
(defun isearch-highlight-lines-matching-regexp ()
"Exit Isearch mode and call `highlight-lines-matching-regexp'.
The arguments passed to `highlight-lines-matching-regexp' are the
regexp from the last search and the face from `hi-lock-read-face-name'."
(interactive)
- (isearch--highlight-regexp-or-lines 'highlight-lines-matching-regexp))
+ (isearch--highlight-regexp-or-lines
+ #'(lambda (regexp face _lighter)
+ (highlight-lines-matching-regexp regexp face))))
(defun isearch-delete-char ()
@@ -2518,6 +2541,8 @@ is bound to outside of Isearch."
(let ((pasted-text (nth 1 event)))
(isearch-yank-string pasted-text))))
+(defvar isearch--yank-prev-point nil)
+
(defun isearch-yank-internal (jumpform)
"Pull the text from point to the point reached by JUMPFORM.
JUMPFORM is a lambda expression that takes no arguments and returns
@@ -2528,7 +2553,14 @@ or it might return the position of the end of the line."
(save-excursion
(and (not isearch-forward) isearch-other-end
(goto-char isearch-other-end))
- (buffer-substring-no-properties (point) (funcall jumpform)))))
+ (and (not isearch-success) isearch--yank-prev-point
+ (goto-char isearch--yank-prev-point))
+ (buffer-substring-no-properties
+ (point)
+ (prog1
+ (setq isearch--yank-prev-point (funcall jumpform))
+ (when isearch-success
+ (setq isearch--yank-prev-point nil)))))))
(defun isearch-yank-char-in-minibuffer (&optional arg)
"Pull next character from buffer into end of search string in minibuffer."
@@ -3237,6 +3269,8 @@ the word mode."
(< (point) isearch-opoint)))
"over")
(if isearch-wrapped "wrapped ")
+ (if (and (not isearch-success) (buffer-narrowed-p) widen-automatically)
+ "narrowed " "")
(if (and (not isearch-success) (not isearch-case-fold-search))
"case-sensitive ")
(let ((prefix ""))
@@ -3425,9 +3459,10 @@ Optional third argument, if t, means if fail just return nil (no error).
(match-beginning 0) (match-end 0)))
(setq retry nil)))
(setq isearch-just-started nil)
- (if isearch-success
- (setq isearch-other-end
- (if isearch-forward (match-beginning 0) (match-end 0)))))
+ (when isearch-success
+ (setq isearch-other-end
+ (if isearch-forward (match-beginning 0) (match-end 0)))
+ (setq isearch-match-data (match-data t))))
(quit (isearch-unread ?\C-g)
(setq isearch-success nil))
@@ -3443,7 +3478,10 @@ Optional third argument, if t, means if fail just return nil (no error).
(string-match "\\`Regular expression too big" isearch-error))
(cond
(isearch-regexp-function
- (setq isearch-error "Too many words"))
+ (setq isearch-error nil)
+ (setq isearch-regexp-function nil)
+ (isearch-search-and-update)
+ (isearch--momentary-message "Too many words; switched to literal mode" 2))
((and isearch-lax-whitespace search-whitespace-regexp)
(setq isearch-error "Too many spaces for whitespace matching"))))))
@@ -3651,8 +3689,29 @@ since they have special meaning in a regexp."
;; Highlighting
(defvar isearch-overlay nil)
+(defvar isearch-submatches-overlays nil)
-(defun isearch-highlight (beg end)
+(defface isearch-group-1
+ '((((class color) (min-colors 88) (background light))
+ (:background "#f000f0" :foreground "lightskyblue1"))
+ (((class color) (min-colors 88) (background dark))
+ (:background "palevioletred1" :foreground "brown4"))
+ (t (:inherit isearch)))
+ "Face for highlighting Isearch the odd group matches."
+ :group 'isearch
+ :version "28.1")
+
+(defface isearch-group-2
+ '((((class color) (min-colors 88) (background light))
+ (:background "#a000a0" :foreground "lightskyblue1"))
+ (((class color) (min-colors 88) (background dark))
+ (:background "palevioletred3" :foreground "brown4"))
+ (t (:inherit isearch)))
+ "Face for highlighting Isearch the even group matches."
+ :group 'isearch
+ :version "28.1")
+
+(defun isearch-highlight (beg end &optional match-data)
(if search-highlight
(if isearch-overlay
;; Overlay already exists, just move it.
@@ -3661,11 +3720,33 @@ since they have special meaning in a regexp."
(setq isearch-overlay (make-overlay beg end))
;; 1001 is higher than lazy's 1000 and ediff's 100+
(overlay-put isearch-overlay 'priority 1001)
- (overlay-put isearch-overlay 'face isearch-face))))
+ (overlay-put isearch-overlay 'face isearch-face)))
+
+ (when (and search-highlight-submatches
+ isearch-regexp)
+ (mapc 'delete-overlay isearch-submatches-overlays)
+ (setq isearch-submatches-overlays nil)
+ (let ((submatch-data (cddr (butlast match-data)))
+ (group 0)
+ ov face)
+ (while submatch-data
+ (setq group (1+ group))
+ (setq ov (make-overlay (pop submatch-data) (pop submatch-data))
+ face (intern-soft (format "isearch-group-%d" group)))
+ ;; Recycle faces from beginning.
+ (unless (facep face)
+ (setq group 1 face 'isearch-group-1))
+ (overlay-put ov 'face face)
+ (overlay-put ov 'priority 1002)
+ (push ov isearch-submatches-overlays)))))
(defun isearch-dehighlight ()
(when isearch-overlay
- (delete-overlay isearch-overlay)))
+ (delete-overlay isearch-overlay))
+ (when search-highlight-submatches
+ (mapc 'delete-overlay isearch-submatches-overlays)
+ (setq isearch-submatches-overlays nil)))
+
;; isearch-lazy-highlight feature
;; by Bob Glickstein <http://www.zanshin.com/~bobg/>
@@ -3866,9 +3947,10 @@ Attempt to do the search exactly the way the pending Isearch would."
(isearch-regexp-lax-whitespace
isearch-lazy-highlight-regexp-lax-whitespace)
(isearch-forward isearch-lazy-highlight-forward)
- ;; Match invisible text only when counting matches
- ;; and user can visit invisible matches
- (search-invisible (and isearch-lazy-count search-invisible t))
+ ;; Don't match invisible text unless it can be opened
+ ;; or when counting matches and user can visit hidden matches
+ (search-invisible (or (eq search-invisible 'open)
+ (and isearch-lazy-count search-invisible)))
(retry t)
(success nil))
;; Use a loop like in `isearch-search'.
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 95cc02197c1..8b3384ae827 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -48,8 +48,7 @@ Preserves the `buffer-modified-p' state of the current buffer."
"Jit-lock fontifies chunks of at most this many characters at a time.
This variable controls both display-time and stealth fontification."
- :type 'integer
- :group 'jit-lock)
+ :type 'integer)
(defcustom jit-lock-stealth-time nil
@@ -59,8 +58,7 @@ If nil, stealth fontification is never performed.
The value of this variable is used when JIT Lock mode is turned on."
:type '(choice (const :tag "never" nil)
- (number :tag "seconds" :value 16))
- :group 'jit-lock)
+ (number :tag "seconds" :value 16)))
(defcustom jit-lock-stealth-nice 0.5
@@ -72,8 +70,7 @@ To reduce machine load during stealth fontification, at the cost of stealth
taking longer to fontify, you could increase the value of this variable.
See also `jit-lock-stealth-load'."
:type '(choice (const :tag "never" nil)
- (number :tag "seconds"))
- :group 'jit-lock)
+ (number :tag "seconds")))
(defcustom jit-lock-stealth-load
@@ -89,14 +86,12 @@ See also `jit-lock-stealth-nice'."
:type (if (condition-case nil (load-average) (error))
'(choice (const :tag "never" nil)
(integer :tag "load"))
- '(const :format "%t: unsupported\n" nil))
- :group 'jit-lock)
+ '(const :format "%t: unsupported\n" nil)))
(defcustom jit-lock-stealth-verbose nil
"If non-nil, means stealth fontification should show status messages."
- :type 'boolean
- :group 'jit-lock)
+ :type 'boolean)
(defvaralias 'jit-lock-defer-contextually 'jit-lock-contextually)
@@ -121,13 +116,11 @@ and sets the buffer-local value of `jit-lock-contextually' to t).
The value of this variable is used when JIT Lock mode is turned on."
:type '(choice (const :tag "never" nil)
(const :tag "always" t)
- (other :tag "syntax-driven" syntax-driven))
- :group 'jit-lock)
+ (other :tag "syntax-driven" syntax-driven)))
(defcustom jit-lock-context-time 0.5
"Idle time after which text is contextually refontified, if applicable."
- :type '(number :tag "seconds")
- :group 'jit-lock)
+ :type '(number :tag "seconds"))
(defcustom jit-lock-antiblink-grace 2
"Delay after which to refontify unterminated strings and comments.
@@ -140,14 +133,12 @@ and comments, the delay helps avoid unpleasant \"blinking\", between
string/comment and non-string/non-comment fontification."
:type '(choice (const :tag "never" nil)
(number :tag "seconds"))
- :group 'jit-lock
:version "27.1")
(defcustom jit-lock-defer-time nil ;; 0.25
"Idle time after which deferred fontification should take place.
If nil, fontification is not deferred.
If 0, then fontification is only deferred while there is input pending."
- :group 'jit-lock
:type '(choice (const :tag "never" nil)
(number :tag "seconds")))
@@ -156,9 +147,10 @@ If 0, then fontification is only deferred while there is input pending."
(defvar-local jit-lock-mode nil
"Non-nil means Just-in-time Lock mode is active.")
-(defvar-local jit-lock-functions nil
- "Functions to do the actual fontification.
-They are called with two arguments: the START and END of the region to fontify.")
+(defvar jit-lock-functions nil
+ "Special hook run to do the actual fontification.
+The functions are called with two arguments:
+the START and END of the region to fontify.")
(defvar-local jit-lock-context-unfontify-pos nil
"Consider text after this position as contextually unfontified.
@@ -268,7 +260,7 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
;; Setup our hooks.
(add-hook 'after-change-functions 'jit-lock-after-change nil t)
- (add-hook 'fontification-functions 'jit-lock-function))
+ (add-hook 'fontification-functions 'jit-lock-function nil t))
;; Turn Just-in-time Lock mode off.
(t
@@ -300,7 +292,7 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
When this minor mode is enabled, jit-lock runs as little code as possible
during redisplay and moves the rest to a timer, where things
like `debug-on-error' and Edebug can be used."
- :global t :group 'jit-lock
+ :global t
(when jit-lock-defer-timer
(cancel-timer jit-lock-defer-timer)
(setq jit-lock-defer-timer nil))
@@ -350,7 +342,8 @@ If non-nil, CONTEXTUAL means that a contextual fontification would be useful."
"Unregister FUN as a fontification function.
Only applies to the current buffer."
(remove-hook 'jit-lock-functions fun t)
- (unless jit-lock-functions (jit-lock-mode nil)))
+ (when (member jit-lock-functions '(nil '(t)))
+ (jit-lock-mode nil)))
(defun jit-lock-refontify (&optional beg end)
"Force refontification of the region BEG..END (default whole buffer)."
@@ -444,8 +437,8 @@ Defaults to the whole buffer. END can be out of bounds."
(quit (put-text-property start next 'fontified nil)
(signal (car err) (cdr err))))))
- ;; In case we fontified more than requested, take advantage of the
- ;; good news.
+ ;; In case we fontified more than requested, take
+ ;; advantage of the good news.
(when (or (< tight-beg start) (> tight-end next))
(put-text-property tight-beg tight-end 'fontified t))
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index eef3d14fe21..e1a3058695a 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -664,11 +664,11 @@ and `inhibit-local-variables-suffixes' that were added
by `jka-compr-installed'."
;; Delete from inhibit-local-variables-suffixes what jka-compr-install added.
(mapc
- (function (lambda (x)
- (and (jka-compr-info-strip-extension x)
- (setq inhibit-local-variables-suffixes
- (delete (jka-compr-info-regexp x)
- inhibit-local-variables-suffixes)))))
+ (lambda (x)
+ (and (jka-compr-info-strip-extension x)
+ (setq inhibit-local-variables-suffixes
+ (delete (jka-compr-info-regexp x)
+ inhibit-local-variables-suffixes))))
jka-compr-compression-info-list--internal)
(let* ((fnha (cons nil file-name-handler-alist))
diff --git a/lisp/json.el b/lisp/json.el
index ac323dac295..c2fc1574faa 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Theresa O'Connor <ted@oconnor.cx>
-;; Version: 1.4
+;; Version: 1.5
;; Keywords: convenience
;; This file is part of GNU Emacs.
@@ -29,11 +29,11 @@
;; Learn all about JSON here: <URL:http://json.org/>.
;; The user-serviceable entry points for the parser are the functions
-;; `json-read' and `json-read-from-string'. The encoder has a single
+;; `json-read' and `json-read-from-string'. The encoder has a single
;; entry point, `json-encode'.
;; Since there are several natural representations of key-value pair
-;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
+;; mappings in Elisp (alist, plist, hash-table), `json-read' allows you
;; to specify which you'd prefer (see `json-object-type' and
;; `json-array-type').
@@ -55,6 +55,7 @@
;;; Code:
(require 'map)
+(require 'seq)
(require 'subr-x)
;; Parameters
@@ -113,8 +114,10 @@ Used only when `json-encoding-pretty-print' is non-nil.")
"If non-nil, then the output of `json-encode' will be pretty-printed.")
(defvar json-encoding-lisp-style-closings nil
- "If non-nil, ] and } closings will be formatted lisp-style,
-without indentation.")
+ "If non-nil, delimiters ] and } will be formatted Lisp-style.
+This means they will be placed on the same line as the last
+element of the respective array or object, without indentation.
+Used only when `json-encoding-pretty-print' is non-nil.")
(defvar json-encoding-object-sort-predicate nil
"Sorting predicate for JSON object keys during encoding.
@@ -124,88 +127,81 @@ instance, setting this to `string<' will have JSON object keys
ordered alphabetically.")
(defvar json-pre-element-read-function nil
- "Function called (if non-nil) by `json-read-array' and
-`json-read-object' right before reading a JSON array or object,
-respectively. The function is called with one argument, which is
-the current JSON key.")
+ "If non-nil, a function to call before reading a JSON array or object.
+It is called by `json-read-array' and `json-read-object',
+respectively, with one argument, which is the current JSON key.")
(defvar json-post-element-read-function nil
- "Function called (if non-nil) by `json-read-array' and
-`json-read-object' right after reading a JSON array or object,
-respectively.")
+ "If non-nil, a function to call after reading a JSON array or object.
+It is called by `json-read-array' and `json-read-object',
+respectively, with no arguments.")
;;; Utilities
-(defun json-join (strings separator)
- "Join STRINGS with SEPARATOR."
- (mapconcat 'identity strings separator))
+(define-obsolete-function-alias 'json-join #'string-join "28.1")
(defun json-alist-p (list)
- "Non-null if and only if LIST is an alist with simple keys."
- (while (consp list)
- (setq list (if (and (consp (car list))
- (atom (caar list)))
- (cdr list)
- 'not-alist)))
+ "Non-nil if and only if LIST is an alist with simple keys."
+ (declare (pure t) (side-effect-free error-free))
+ (while (and (consp (car-safe list))
+ (atom (caar list))
+ (setq list (cdr list))))
(null list))
(defun json-plist-p (list)
- "Non-null if and only if LIST is a plist with keyword keys."
- (while (consp list)
- (setq list (if (and (keywordp (car list))
- (consp (cdr list)))
- (cddr list)
- 'not-plist)))
+ "Non-nil if and only if LIST is a plist with keyword keys."
+ (declare (pure t) (side-effect-free error-free))
+ (while (and (keywordp (car-safe list))
+ (consp (cdr list))
+ (setq list (cddr list))))
(null list))
-(defun json--plist-reverse (plist)
- "Return a copy of PLIST in reverse order.
-Unlike `reverse', this keeps the property-value pairs intact."
- (let (res)
- (while plist
- (let ((prop (pop plist))
- (val (pop plist)))
- (push val res)
- (push prop res)))
- res))
-
-(defun json--plist-to-alist (plist)
- "Return an alist of the property-value pairs in PLIST."
- (let (res)
- (while plist
- (let ((prop (pop plist))
- (val (pop plist)))
- (push (cons prop val) res)))
- (nreverse res)))
-
-(defmacro json--with-indentation (body)
+(defun json--plist-nreverse (plist)
+ "Return PLIST in reverse order.
+Unlike `nreverse', this keeps the ordering of each property
+relative to its value intact. Like `nreverse', this function may
+destructively modify PLIST to produce the result."
+ (let (prev (next (cddr plist)))
+ (while next
+ (setcdr (cdr plist) prev)
+ (setq prev plist plist next next (cddr next))
+ (setcdr (cdr plist) prev)))
+ plist)
+
+(defmacro json--with-indentation (&rest body)
+ "Evaluate BODY with the correct indentation for JSON encoding.
+This macro binds `json--encoding-current-indentation' according
+to `json-encoding-pretty-print' around BODY."
+ (declare (debug t) (indent 0))
`(let ((json--encoding-current-indentation
(if json-encoding-pretty-print
(concat json--encoding-current-indentation
json-encoding-default-indentation)
"")))
- ,body))
+ ,@body))
;; Reader utilities
(define-inline json-advance (&optional n)
- "Advance N characters forward."
+ "Advance N characters forward, or 1 character if N is nil.
+On reaching the end of the accessible region of the buffer, stop
+and signal an error."
(inline-quote (forward-char ,n)))
(define-inline json-peek ()
- "Return the character at point."
+ "Return the character at point.
+At the end of the accessible region of the buffer, return 0."
(inline-quote (following-char)))
(define-inline json-pop ()
- "Advance past the character at point, returning it."
+ "Advance past the character at point, returning it.
+Signal `json-end-of-file' if called at the end of the buffer."
(inline-quote
- (let ((char (json-peek)))
- (if (zerop char)
- (signal 'json-end-of-file nil)
- (json-advance)
- char))))
+ (prog1 (or (char-after)
+ (signal 'json-end-of-file ()))
+ (json-advance))))
(define-inline json-skip-whitespace ()
"Skip past the whitespace at point."
@@ -213,7 +209,7 @@ Unlike `reverse', this keeps the property-value pairs intact."
;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf
;; or https://tools.ietf.org/html/rfc7159#section-2 for the
;; definition of whitespace in JSON.
- (inline-quote (skip-chars-forward "\t\r\n ")))
+ (inline-quote (skip-chars-forward "\t\n\r ")))
@@ -227,6 +223,7 @@ Unlike `reverse', this keeps the property-value pairs intact."
(define-error 'json-string-format "Bad string format" 'json-error)
(define-error 'json-key-format "Bad JSON object key" 'json-error)
(define-error 'json-object-format "Bad JSON object" 'json-error)
+(define-error 'json-array-format "Bad JSON array" 'json-error)
(define-error 'json-end-of-file "End of file while parsing JSON"
'(end-of-file json-error))
@@ -235,8 +232,8 @@ Unlike `reverse', this keeps the property-value pairs intact."
;;; Paths
(defvar json--path '()
- "Used internally by `json-path-to-position' to keep track of
-the path during recursive calls to `json-read'.")
+ "Keeps track of the path during recursive calls to `json-read'.
+Used internally by `json-path-to-position'.")
(defun json--record-path (key)
"Record the KEY to the current JSON path.
@@ -247,7 +244,7 @@ Used internally by `json-path-to-position'."
"Check if the last parsed JSON structure passed POSITION.
Used internally by `json-path-to-position'."
(let ((start (caar json--path)))
- (when (< start position (+ (point) 1))
+ (when (< start position (1+ (point)))
(throw :json-path (list :path (nreverse (mapcar #'cdr json--path))
:match-start start
:match-end (point)))))
@@ -265,13 +262,13 @@ properties:
:path -- A list of strings and numbers forming the path to
the JSON element at the given position. Strings
denote object names, while numbers denote array
- indexes.
+ indices.
:match-start -- Position where the matched JSON element begins.
:match-end -- Position where the matched JSON element ends.
-This can for instance be useful to determine the path to a JSON
+This can, for instance, be useful to determine the path to a JSON
element in a deeply nested structure."
(save-excursion
(unless string
@@ -279,7 +276,7 @@ element in a deeply nested structure."
(let* ((json--path '())
(json-pre-element-read-function #'json--record-path)
(json-post-element-read-function
- (apply-partially #'json--check-position position))
+ (lambda () (json--check-position position)))
(path (catch :json-path
(if string
(json-read-from-string string)
@@ -289,38 +286,33 @@ element in a deeply nested structure."
;;; Keywords
-(defvar json-keywords '("true" "false" "null")
+(defconst json-keywords '("true" "false" "null")
"List of JSON keywords.")
+(make-obsolete-variable 'json-keywords "it is no longer used." "28.1")
;; Keyword parsing
+;; Characters that can follow a JSON value.
+(rx-define json--post-value (| (in "\t\n\r ,]}") eos))
+
(defun json-read-keyword (keyword)
- "Read a JSON keyword at point.
-KEYWORD is the keyword expected."
- (unless (member keyword json-keywords)
- (signal 'json-unknown-keyword (list keyword)))
- (mapc (lambda (char)
- (when (/= char (json-peek))
- (signal 'json-unknown-keyword
- (list (save-excursion
- (backward-word-strictly 1)
- (thing-at-point 'word)))))
- (json-advance))
- keyword)
- (json-skip-whitespace)
- (unless (looking-at "\\([],}]\\|$\\)")
- (signal 'json-unknown-keyword
- (list (save-excursion
- (backward-word-strictly 1)
- (thing-at-point 'word)))))
- (cond ((string-equal keyword "true") t)
- ((string-equal keyword "false") json-false)
- ((string-equal keyword "null") json-null)))
+ "Read the expected JSON KEYWORD at point."
+ (prog1 (cond ((equal keyword "true") t)
+ ((equal keyword "false") json-false)
+ ((equal keyword "null") json-null)
+ (t (signal 'json-unknown-keyword (list keyword))))
+ (or (looking-at-p keyword)
+ (signal 'json-unknown-keyword (list (thing-at-point 'word))))
+ (json-advance (length keyword))
+ (or (looking-at-p (rx json--post-value))
+ (signal 'json-unknown-keyword (list (thing-at-point 'word))))
+ (json-skip-whitespace)))
;; Keyword encoding
(defun json-encode-keyword (keyword)
"Encode KEYWORD as a JSON value."
+ (declare (side-effect-free t))
(cond ((eq keyword t) "true")
((eq keyword json-false) "false")
((eq keyword json-null) "null")))
@@ -329,37 +321,31 @@ KEYWORD is the keyword expected."
;; Number parsing
-(defun json-read-number (&optional sign)
- "Read the JSON number following point.
-The optional SIGN argument is for internal use.
-
-N.B.: Only numbers which can fit in Emacs Lisp's native number
-representation will be parsed correctly."
- ;; If SIGN is non-nil, the number is explicitly signed.
- (let ((number-regexp
- "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
- (cond ((and (null sign) (= (json-peek) ?-))
- (json-advance)
- (- (json-read-number t)))
- ((and (null sign) (= (json-peek) ?+))
- (json-advance)
- (json-read-number t))
- ((and (looking-at number-regexp)
- (or (match-beginning 1)
- (match-beginning 2)))
- (goto-char (match-end 0))
- (string-to-number (match-string 0)))
- (t (signal 'json-number-format (list (point)))))))
+(rx-define json--number
+ (: (? ?-) ; Sign.
+ (| (: (in "1-9") (* digit)) ?0) ; Integer.
+ (? ?. (+ digit)) ; Fraction.
+ (? (in "Ee") (? (in ?+ ?-)) (+ digit)))) ; Exponent.
+
+(defun json-read-number (&optional _sign)
+ "Read the JSON number following point."
+ (declare (advertised-calling-convention () "28.1"))
+ (or (looking-at (rx json--number))
+ (signal 'json-number-format (list (point))))
+ (goto-char (match-end 0))
+ (prog1 (string-to-number (match-string 0))
+ (or (looking-at-p (rx json--post-value))
+ (signal 'json-number-format (list (point))))
+ (json-skip-whitespace)))
;; Number encoding
-(defun json-encode-number (number)
- "Return a JSON representation of NUMBER."
- (format "%s" number))
+(defalias 'json-encode-number #'number-to-string
+ "Return a JSON representation of NUMBER.")
;;; Strings
-(defvar json-special-chars
+(defconst json-special-chars
'((?\" . ?\")
(?\\ . ?\\)
(?b . ?\b)
@@ -367,7 +353,7 @@ representation will be parsed correctly."
(?n . ?\n)
(?r . ?\r)
(?t . ?\t))
- "Characters which are escaped in JSON, with their elisp counterparts.")
+ "Characters which are escaped in JSON, with their Elisp counterparts.")
;; String parsing
@@ -377,48 +363,47 @@ representation will be parsed correctly."
(defun json-read-escaped-char ()
"Read the JSON string escaped character at point."
- ;; Skip over the '\'
+ ;; Skip over the '\'.
(json-advance)
- (let* ((char (json-pop))
- (special (assq char json-special-chars)))
+ (let ((char (json-pop)))
(cond
- (special (cdr special))
- ((not (eq char ?u)) char)
+ ((cdr (assq char json-special-chars)))
+ ((/= char ?u) char)
;; Special-case UTF-16 surrogate pairs,
;; cf. <https://tools.ietf.org/html/rfc7159#section-7>. Note that
;; this clause overlaps with the next one and therefore has to
;; come first.
((looking-at
- (rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit)))
- "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit)))))
+ (rx (group (any "Dd") (any "89ABab") (= 2 xdigit))
+ "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 xdigit))))
(json-advance 10)
(json--decode-utf-16-surrogates
(string-to-number (match-string 1) 16)
(string-to-number (match-string 2) 16)))
((looking-at (rx (= 4 xdigit)))
- (let ((hex (match-string 0)))
- (json-advance 4)
- (string-to-number hex 16)))
+ (json-advance 4)
+ (string-to-number (match-string 0) 16))
(t
(signal 'json-string-escape (list (point)))))))
(defun json-read-string ()
"Read the JSON string at point."
- (unless (= (json-peek) ?\")
- (signal 'json-string-format (list "doesn't start with `\"'!")))
- ;; Skip over the '"'
+ ;; Skip over the '"'.
(json-advance)
(let ((characters '())
(char (json-peek)))
- (while (not (= char ?\"))
+ (while (/= char ?\")
(when (< char 32)
- (signal 'json-string-format (list (prin1-char char))))
+ (if (zerop char)
+ (signal 'json-end-of-file ())
+ (signal 'json-string-format (list char))))
(push (if (= char ?\\)
(json-read-escaped-char)
- (json-pop))
+ (json-advance)
+ char)
characters)
(setq char (json-peek)))
- ;; Skip over the '"'
+ ;; Skip over the '"'.
(json-advance)
(if characters
(concat (nreverse characters))
@@ -426,29 +411,47 @@ representation will be parsed correctly."
;; String encoding
+;; Escape only quotation mark, backslash, and the control
+;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
+(rx-define json--escape (in ?\" ?\\ cntrl))
+
+(defvar json--long-string-threshold 200
+ "Length above which strings are considered long for JSON encoding.
+It is generally faster to manipulate such strings in a buffer
+rather than directly.")
+
+(defvar json--string-buffer nil
+ "Buffer used for encoding Lisp strings as JSON.
+Initialized lazily by `json-encode-string'.")
+
(defun json-encode-string (string)
"Return a JSON representation of STRING."
- ;; Reimplement the meat of `replace-regexp-in-string', for
- ;; performance (bug#20154).
- (let ((l (length string))
- (start 0)
- res mb)
- ;; Only escape quotation mark, backslash and the control
- ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
- (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
- (let* ((c (aref string mb))
- (special (rassq c json-special-chars)))
- (push (substring string start mb) res)
- (push (if special
- ;; Special JSON character (\n, \r, etc.).
- (string ?\\ (car special))
- ;; Fallback: UCS code point in \uNNNN form.
- (format "\\u%04x" c))
- res)
- (setq start (1+ mb))))
- (push (substring string start l) res)
- (push "\"" res)
- (apply #'concat "\"" (nreverse res))))
+ ;; Try to avoid buffer overhead in trivial cases, while also
+ ;; avoiding searching pathological strings for escape characters.
+ ;; Since `string-match-p' doesn't take a LIMIT argument, we use
+ ;; string length as our heuristic. See also bug#20154.
+ (if (and (< (length string) json--long-string-threshold)
+ (not (string-match-p (rx json--escape) string)))
+ (concat "\"" (substring-no-properties string) "\"")
+ (with-current-buffer
+ (or json--string-buffer
+ (with-current-buffer (generate-new-buffer " *json-string*")
+ ;; This seems to afford decent performance gains.
+ (setq-local inhibit-modification-hooks t)
+ (setq json--string-buffer (current-buffer))))
+ (insert ?\" (substring-no-properties string)) ; see bug#43549
+ (goto-char (1+ (point-min)))
+ (while (re-search-forward (rx json--escape) nil 'move)
+ (let ((char (preceding-char)))
+ (delete-char -1)
+ (insert ?\\ (or
+ ;; Special JSON character (\n, \r, etc.).
+ (car (rassq char json-special-chars))
+ ;; Fallback: UCS code point in \uNNNN form.
+ (format "u%04x" char)))))
+ (insert ?\")
+ ;; Empty buffer for next invocation.
+ (delete-and-extract-region (point-min) (point-max)))))
(defun json-encode-key (object)
"Return a JSON representation of OBJECT.
@@ -459,15 +462,13 @@ this signals `json-key-format'."
(signal 'json-key-format (list object)))
encoded))
-;;; JSON Objects
+;;; Objects
(defun json-new-object ()
- "Create a new Elisp object corresponding to a JSON object.
+ "Create a new Elisp object corresponding to an empty JSON object.
Please see the documentation of `json-object-type'."
- (cond ((eq json-object-type 'hash-table)
- (make-hash-table :test 'equal))
- (t
- ())))
+ (and (eq json-object-type 'hash-table)
+ (make-hash-table :test #'equal)))
(defun json-add-to-object (object key value)
"Add a new KEY -> VALUE association to OBJECT.
@@ -475,10 +476,10 @@ Returns the updated object, which you should save, e.g.:
(setq obj (json-add-to-object obj \"foo\" \"bar\"))
Please see the documentation of `json-object-type' and `json-key-type'."
(let ((json-key-type
- (or json-key-type
- (cdr (assq json-object-type '((hash-table . string)
- (alist . symbol)
- (plist . keyword)))))))
+ (cond (json-key-type)
+ ((eq json-object-type 'hash-table) 'string)
+ ((eq json-object-type 'alist) 'symbol)
+ ((eq json-object-type 'plist) 'keyword))))
(setq key
(cond ((eq json-key-type 'string)
key)
@@ -498,13 +499,13 @@ Please see the documentation of `json-object-type' and `json-key-type'."
(defun json-read-object ()
"Read the JSON object at point."
- ;; Skip over the "{"
+ ;; Skip over the '{'.
(json-advance)
(json-skip-whitespace)
- ;; read key/value pairs until "}"
+ ;; Read key/value pairs until '}'.
(let ((elements (json-new-object))
key value)
- (while (not (= (json-peek) ?}))
+ (while (/= (json-peek) ?\})
(json-skip-whitespace)
(setq key (json-read-string))
(json-skip-whitespace)
@@ -519,94 +520,94 @@ Please see the documentation of `json-object-type' and `json-key-type'."
(funcall json-post-element-read-function))
(setq elements (json-add-to-object elements key value))
(json-skip-whitespace)
- (when (/= (json-peek) ?})
+ (when (/= (json-peek) ?\})
(if (= (json-peek) ?,)
(json-advance)
(signal 'json-object-format (list "," (json-peek))))))
- ;; Skip over the "}"
+ ;; Skip over the '}'.
(json-advance)
(pcase json-object-type
('alist (nreverse elements))
- ('plist (json--plist-reverse elements))
+ ('plist (json--plist-nreverse elements))
(_ elements))))
;; Hash table encoding
(defun json-encode-hash-table (hash-table)
"Return a JSON representation of HASH-TABLE."
- (if json-encoding-object-sort-predicate
- (json-encode-alist (map-into hash-table 'list))
- (format "{%s%s}"
- (json-join
- (let (r)
- (json--with-indentation
- (maphash
- (lambda (k v)
- (push (format
- (if json-encoding-pretty-print
- "%s%s: %s"
- "%s%s:%s")
- json--encoding-current-indentation
- (json-encode-key k)
- (json-encode v))
- r))
- hash-table))
- r)
- json-encoding-separator)
- (if (or (not json-encoding-pretty-print)
- json-encoding-lisp-style-closings)
- ""
- json--encoding-current-indentation))))
+ (cond ((hash-table-empty-p hash-table) "{}")
+ (json-encoding-object-sort-predicate
+ (json--encode-alist (map-pairs hash-table) t))
+ (t
+ (let ((kv-sep (if json-encoding-pretty-print ": " ":"))
+ result)
+ (json--with-indentation
+ (maphash
+ (lambda (k v)
+ (push (concat json--encoding-current-indentation
+ (json-encode-key k)
+ kv-sep
+ (json-encode v))
+ result))
+ hash-table))
+ (concat "{"
+ (string-join (nreverse result) json-encoding-separator)
+ (and json-encoding-pretty-print
+ (not json-encoding-lisp-style-closings)
+ json--encoding-current-indentation)
+ "}")))))
;; List encoding (including alists and plists)
-(defun json-encode-alist (alist)
- "Return a JSON representation of ALIST."
+(defun json--encode-alist (alist &optional destructive)
+ "Return a JSON representation of ALIST.
+DESTRUCTIVE non-nil means it is safe to modify ALIST by
+side-effects."
(when json-encoding-object-sort-predicate
- (setq alist
- (sort alist (lambda (a b)
+ (setq alist (sort (if destructive alist (copy-sequence alist))
+ (lambda (a b)
(funcall json-encoding-object-sort-predicate
(car a) (car b))))))
- (format "{%s%s}"
- (json-join
- (json--with-indentation
- (mapcar (lambda (cons)
- (format (if json-encoding-pretty-print
- "%s%s: %s"
- "%s%s:%s")
- json--encoding-current-indentation
- (json-encode-key (car cons))
- (json-encode (cdr cons))))
- alist))
- json-encoding-separator)
- (if (or (not json-encoding-pretty-print)
- json-encoding-lisp-style-closings)
- ""
- json--encoding-current-indentation)))
+ (concat "{"
+ (let ((kv-sep (if json-encoding-pretty-print ": " ":")))
+ (json--with-indentation
+ (mapconcat (lambda (cons)
+ (concat json--encoding-current-indentation
+ (json-encode-key (car cons))
+ kv-sep
+ (json-encode (cdr cons))))
+ alist
+ json-encoding-separator)))
+ (and json-encoding-pretty-print
+ (not json-encoding-lisp-style-closings)
+ json--encoding-current-indentation)
+ "}"))
+
+(defun json-encode-alist (alist)
+ "Return a JSON representation of ALIST."
+ (if alist (json--encode-alist alist) "{}"))
(defun json-encode-plist (plist)
"Return a JSON representation of PLIST."
- (if json-encoding-object-sort-predicate
- (json-encode-alist (json--plist-to-alist plist))
- (let (result)
- (json--with-indentation
- (while plist
- (push (concat
- json--encoding-current-indentation
- (json-encode-key (car plist))
- (if json-encoding-pretty-print
- ": "
- ":")
- (json-encode (cadr plist)))
+ (cond ((null plist) "{}")
+ (json-encoding-object-sort-predicate
+ (json--encode-alist (map-pairs plist) t))
+ (t
+ (let ((kv-sep (if json-encoding-pretty-print ": " ":"))
result)
- (setq plist (cddr plist))))
- (concat "{"
- (json-join (nreverse result) json-encoding-separator)
- (if (and json-encoding-pretty-print
- (not json-encoding-lisp-style-closings))
- json--encoding-current-indentation
- "")
- "}"))))
+ (json--with-indentation
+ (while plist
+ (push (concat json--encoding-current-indentation
+ (json-encode-key (pop plist))
+ kv-sep
+ (json-encode (pop plist)))
+ result)))
+ (concat "{"
+ (string-join (nreverse result) json-encoding-separator)
+ (and json-encoding-pretty-print
+ (not json-encoding-lisp-style-closings)
+ json--encoding-current-indentation)
+ "}")))))
(defun json-encode-list (list)
"Return a JSON representation of LIST.
@@ -624,15 +625,17 @@ become JSON objects."
(defun json-read-array ()
"Read the JSON array at point."
- ;; Skip over the "["
+ ;; Skip over the '['.
(json-advance)
(json-skip-whitespace)
- ;; read values until "]"
- (let (elements)
- (while (not (= (json-peek) ?\]))
+ ;; Read values until ']'.
+ (let (elements
+ (len 0))
+ (while (/= (json-peek) ?\])
(json-skip-whitespace)
(when json-pre-element-read-function
- (funcall json-pre-element-read-function (length elements)))
+ (funcall json-pre-element-read-function len)
+ (setq len (1+ len)))
(push (json-read) elements)
(when json-post-element-read-function
(funcall json-post-element-read-function))
@@ -640,8 +643,8 @@ become JSON objects."
(when (/= (json-peek) ?\])
(if (= (json-peek) ?,)
(json-advance)
- (signal 'json-error (list 'bleah)))))
- ;; Skip over the "]"
+ (signal 'json-array-format (list "," (json-peek))))))
+ ;; Skip over the ']'.
(json-advance)
(pcase json-array-type
('vector (nreverse (vconcat elements)))
@@ -652,42 +655,43 @@ become JSON objects."
(defun json-encode-array (array)
"Return a JSON representation of ARRAY."
(if (and json-encoding-pretty-print
- (> (length array) 0))
+ (not (seq-empty-p array)))
(concat
+ "["
(json--with-indentation
- (concat (format "[%s" json--encoding-current-indentation)
- (json-join (mapcar 'json-encode array)
- (format "%s%s"
- json-encoding-separator
+ (concat json--encoding-current-indentation
+ (mapconcat #'json-encode array
+ (concat json-encoding-separator
json--encoding-current-indentation))))
- (format "%s]"
- (if json-encoding-lisp-style-closings
- ""
- json--encoding-current-indentation)))
+ (unless json-encoding-lisp-style-closings
+ json--encoding-current-indentation)
+ "]")
(concat "["
- (mapconcat 'json-encode array json-encoding-separator)
+ (mapconcat #'json-encode array json-encoding-separator)
"]")))
-;;; JSON reader.
+;;; Reader
(defmacro json-readtable-dispatch (char)
- "Dispatch reader function for CHAR."
- (declare (debug (symbolp)))
- (let ((table
- '((?t json-read-keyword "true")
- (?f json-read-keyword "false")
- (?n json-read-keyword "null")
- (?{ json-read-object)
- (?\[ json-read-array)
- (?\" json-read-string)))
- res)
- (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- (push (list c 'json-read-number) table))
- (pcase-dolist (`(,c . ,rest) table)
- (push `((eq ,char ,c) (,@rest)) res))
- `(cond ,@res (t (signal 'json-readtable-error (list ,char))))))
+ "Dispatch reader function for CHAR at point.
+If CHAR is nil, signal `json-end-of-file'."
+ (declare (debug t))
+ (macroexp-let2 nil char char
+ `(cond ,@(map-apply
+ (lambda (key expr)
+ `((eq ,char ,key) ,expr))
+ `((?\" ,#'json-read-string)
+ (?\[ ,#'json-read-array)
+ (?\{ ,#'json-read-object)
+ (?n ,#'json-read-keyword "null")
+ (?f ,#'json-read-keyword "false")
+ (?t ,#'json-read-keyword "true")
+ ,@(mapcar (lambda (c) (list c #'json-read-number))
+ '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))))
+ (,char (signal 'json-readtable-error (list ,char)))
+ (t (signal 'json-end-of-file ())))))
(defun json-read ()
"Parse and return the JSON object following point.
@@ -705,10 +709,7 @@ you will get the following structure returned:
((c . :json-false))])
(b . \"foo\"))"
(json-skip-whitespace)
- (let ((char (json-peek)))
- (if (zerop char)
- (signal 'json-end-of-file nil)
- (json-readtable-dispatch char))))
+ (json-readtable-dispatch (char-after)))
;; Syntactic sugar for the reader
@@ -723,12 +724,11 @@ you will get the following structure returned:
"Read the first JSON object contained in FILE and return it."
(with-temp-buffer
(insert-file-contents file)
- (goto-char (point-min))
(json-read)))
-;;; JSON encoder
+;;; Encoder
(defun json-encode (object)
"Return a JSON representation of OBJECT as a string.
@@ -736,20 +736,21 @@ you will get the following structure returned:
OBJECT should have a structure like one returned by `json-read'.
If an error is detected during encoding, an error based on
`json-error' is signaled."
- (cond ((memq object (list t json-null json-false))
- (json-encode-keyword object))
- ((stringp object) (json-encode-string object))
- ((keywordp object) (json-encode-string
- (substring (symbol-name object) 1)))
- ((listp object) (json-encode-list object))
- ((symbolp object) (json-encode-string
- (symbol-name object)))
- ((numberp object) (json-encode-number object))
- ((arrayp object) (json-encode-array object))
- ((hash-table-p object) (json-encode-hash-table object))
- (t (signal 'json-error (list object)))))
-
-;; Pretty printing & minimizing
+ (cond ((eq object t) (json-encode-keyword object))
+ ((eq object json-null) (json-encode-keyword object))
+ ((eq object json-false) (json-encode-keyword object))
+ ((stringp object) (json-encode-string object))
+ ((keywordp object) (json-encode-string
+ (substring (symbol-name object) 1)))
+ ((listp object) (json-encode-list object))
+ ((symbolp object) (json-encode-string
+ (symbol-name object)))
+ ((numberp object) (json-encode-number object))
+ ((arrayp object) (json-encode-array object))
+ ((hash-table-p object) (json-encode-hash-table object))
+ (t (signal 'json-error (list object)))))
+
+;;; Pretty printing & minimizing
(defun json-pretty-print-buffer (&optional minimize)
"Pretty-print current buffer.
@@ -768,9 +769,9 @@ MAX-SECS.")
With prefix argument MINIMIZE, minimize it instead."
(interactive "r\nP")
(let ((json-encoding-pretty-print (null minimize))
- ;; Distinguish an empty objects from 'null'
+ ;; Distinguish an empty object from 'null'.
(json-null :json-null)
- ;; Ensure that ordering is maintained
+ ;; Ensure that ordering is maintained.
(json-object-type 'alist)
(orig-buf (current-buffer))
error)
@@ -799,9 +800,7 @@ With prefix argument MINIMIZE, minimize it instead."
;; them.
(let ((space (buffer-substring
(point)
- (+ (point)
- (skip-chars-forward
- " \t\n" (point-max)))))
+ (+ (point) (skip-chars-forward " \t\n"))))
(json (json-read)))
(setq pos (point)) ; End of last good json-read.
(set-buffer tmp-buf)
@@ -831,14 +830,14 @@ With prefix argument MINIMIZE, minimize it instead."
"Pretty-print current buffer with object keys ordered.
With prefix argument MINIMIZE, minimize it instead."
(interactive "P")
- (let ((json-encoding-object-sort-predicate 'string<))
+ (let ((json-encoding-object-sort-predicate #'string<))
(json-pretty-print-buffer minimize)))
(defun json-pretty-print-ordered (begin end &optional minimize)
"Pretty-print the region with object keys ordered.
With prefix argument MINIMIZE, minimize it instead."
(interactive "r\nP")
- (let ((json-encoding-object-sort-predicate 'string<))
+ (let ((json-encoding-object-sort-predicate #'string<))
(json-pretty-print begin end minimize)))
(provide 'json)
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 4567b14da11..7de6baeb00a 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -4,11 +4,11 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
+;; Version: 1.0.12
;; Package-Requires: ((emacs "25.2"))
-;; Version: 1.0.9
-;; This is an Elpa :core package. Don't use functionality that is not
-;; compatible with Emacs 25.2.
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -26,7 +26,7 @@
;;; Commentary:
;; This library implements the JSONRPC 2.0 specification as described
-;; in http://www.jsonrpc.org/. As the name suggests, JSONRPC is a
+;; in https://www.jsonrpc.org/. As the name suggests, JSONRPC is a
;; generic Remote Procedure Call protocol designed around JSON
;; objects. To learn how to write JSONRPC programs with this library,
;; see Info node `(elisp)JSONRPC'."
@@ -37,7 +37,6 @@
;;; Code:
(require 'cl-lib)
-(require 'json)
(require 'eieio)
(eval-when-compile (require 'subr-x))
(require 'warnings)
@@ -275,7 +274,7 @@ error of type `jsonrpc-error'.
DEFERRED is passed to `jsonrpc-async-request', which see.
If CANCEL-ON-INPUT is non-nil and the user inputs something while
-the functino is waiting, then it exits immediately, returning
+the function is waiting, then it exits immediately, returning
CANCEL-ON-INPUT-RETVAL. Any future replies (normal or error) are
ignored."
(let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer
@@ -330,11 +329,14 @@ ignored."
:method method
:params params))
-(defconst jrpc-default-request-timeout 10
+(define-obsolete-variable-alias 'jrpc-default-request-timeout
+ 'jsonrpc-default-request-timeout "28.1")
+
+(defconst jsonrpc-default-request-timeout 10
"Time in seconds before timing out a JSONRPC request.")
-;;; Specfic to `jsonrpc-process-connection'
+;;; Specific to `jsonrpc-process-connection'
;;;
(defclass jsonrpc-process-connection (jsonrpc-connection)
@@ -364,21 +366,53 @@ connection object, called when the process dies .")
(cl-defmethod initialize-instance ((conn jsonrpc-process-connection) slots)
(cl-call-next-method)
- (let* ((proc (plist-get slots :process))
- (proc (if (functionp proc) (funcall proc) proc))
- (buffer (get-buffer-create (format "*%s output*" (process-name proc))))
- (stderr (get-buffer-create (format "*%s stderr*" (process-name proc)))))
+ (cl-destructuring-bind (&key ((:process proc)) name &allow-other-keys) slots
+ ;; FIXME: notice the undocumented bad coupling in the stderr
+ ;; buffer name, it must be named exactly like this we expect when
+ ;; calling `make-process'. If there were a `set-process-stderr'
+ ;; like there is `set-process-buffer' we wouldn't need this and
+ ;; could use a pipe with a process filter instead of
+ ;; `after-change-functions'. Alternatively, we need a new initarg
+ ;; (but maybe not a slot).
+ (let ((calling-buffer (current-buffer)))
+ (with-current-buffer (get-buffer-create (format "*%s stderr*" name))
+ (let ((inhibit-read-only t)
+ (hidden-name (concat " " (buffer-name))))
+ (erase-buffer)
+ (buffer-disable-undo)
+ (add-hook
+ 'after-change-functions
+ (lambda (beg _end _pre-change-len)
+ (cl-loop initially (goto-char beg)
+ do (forward-line)
+ when (bolp)
+ for line = (buffer-substring
+ (line-beginning-position 0)
+ (line-end-position 0))
+ do (with-current-buffer (jsonrpc-events-buffer conn)
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert (format "[stderr] %s\n" line))))
+ until (eobp)))
+ nil t)
+ ;; If we are correctly coupled to the client, the process
+ ;; now created should pick up the current stderr buffer,
+ ;; which we immediately rename
+ (setq proc (if (functionp proc)
+ (with-current-buffer calling-buffer (funcall proc))
+ proc))
+ (ignore-errors (kill-buffer hidden-name))
+ (rename-buffer hidden-name)
+ (process-put proc 'jsonrpc-stderr (current-buffer))
+ (read-only-mode t))))
(setf (jsonrpc--process conn) proc)
- (set-process-buffer proc buffer)
- (process-put proc 'jsonrpc-stderr stderr)
+ (set-process-buffer proc (get-buffer-create (format " *%s output*" name)))
(set-process-filter proc #'jsonrpc--process-filter)
(set-process-sentinel proc #'jsonrpc--process-sentinel)
(with-current-buffer (process-buffer proc)
(buffer-disable-undo)
(set-marker (process-mark proc) (point-min))
- (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t) proc))
- (with-current-buffer stderr
- (buffer-disable-undo))
+ (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t)))
(process-put proc 'jsonrpc-connection conn)))
(cl-defmethod jsonrpc-connection-send ((connection jsonrpc-process-connection)
@@ -442,26 +476,35 @@ With optional CLEANUP, kill any associated buffers."
;;;
(define-error 'jsonrpc-error "jsonrpc-error")
-(defun jsonrpc--json-read ()
- "Read JSON object in buffer, move point to end of buffer."
- ;; TODO: I guess we can make these macros if/when jsonrpc.el
- ;; goes into Emacs core.
- (cond ((fboundp 'json-parse-buffer) (json-parse-buffer
- :object-type 'plist
- :null-object nil
- :false-object :json-false))
- (t (let ((json-object-type 'plist))
- (json-read)))))
-
-(defun jsonrpc--json-encode (object)
- "Encode OBJECT into a JSON string."
- (cond ((fboundp 'json-serialize) (json-serialize
- object
- :false-object :json-false
- :null-object nil))
- (t (let ((json-false :json-false)
- (json-null nil))
- (json-encode object)))))
+(defalias 'jsonrpc--json-read
+ (if (fboundp 'json-parse-buffer)
+ (lambda ()
+ (json-parse-buffer :object-type 'plist
+ :null-object nil
+ :false-object :json-false))
+ (require 'json)
+ (defvar json-object-type)
+ (declare-function json-read "json" ())
+ (lambda ()
+ (let ((json-object-type 'plist))
+ (json-read))))
+ "Read JSON object in buffer, move point to end of buffer.")
+
+(defalias 'jsonrpc--json-encode
+ (if (fboundp 'json-serialize)
+ (lambda (object)
+ (json-serialize object
+ :false-object :json-false
+ :null-object nil))
+ (require 'json)
+ (defvar json-false)
+ (defvar json-null)
+ (declare-function json-encode "json" (object))
+ (lambda (object)
+ (let ((json-false :json-false)
+ (json-null nil))
+ (json-encode object))))
+ "Encode OBJECT into a JSON string.")
(cl-defun jsonrpc--reply
(connection id &key (result nil result-supplied-p) (error nil error-supplied-p))
@@ -577,7 +620,7 @@ With optional CLEANUP, kill any associated buffers."
params
&rest args
&key success-fn error-fn timeout-fn
- (timeout jrpc-default-request-timeout)
+ (timeout jsonrpc-default-request-timeout)
(deferred nil))
"Does actual work for `jsonrpc-async-request'.
@@ -682,7 +725,7 @@ originated."
(format "-%s" subtype)))))
(goto-char (point-max))
(prog1
- (let ((msg (format "%s%s%s %s:\n%s\n"
+ (let ((msg (format "[%s]%s%s %s:\n%s"
type
(if id (format " (id:%s)" id) "")
(if error " ERROR" "")
diff --git a/lisp/kermit.el b/lisp/kermit.el
index b0a4d90932e..f2607bfcf4c 100644
--- a/lisp/kermit.el
+++ b/lisp/kermit.el
@@ -1,4 +1,4 @@
-;;; kermit.el --- additions to shell mode for use with kermit
+;;; kermit.el --- additions to shell mode for use with kermit -*- lexical-binding: t -*-
;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 3a59708d837..3437dba5e6a 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -924,7 +924,7 @@ The ARG parameter is unused."
nil
(if kmacro-view-last-item
(concat (cond ((= kmacro-view-item-no 2) "2nd")
- ((= kmacro-view-item-no 3) "3nd")
+ ((= kmacro-view-item-no 3) "3rd")
(t (format "%dth" kmacro-view-item-no)))
" previous macro")
"Last macro")))
diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el
index 7f2a99a41a2..d689e87d785 100644
--- a/lisp/language/burmese.el
+++ b/lisp/language/burmese.el
@@ -1,4 +1,4 @@
-;;; burmese.el --- support for Burmese -*- coding: utf-8 -*-
+;;; burmese.el --- support for Burmese -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -23,7 +23,6 @@
;;; Commentary:
-;; Aung San Suu Kyi says to call her country "Burma".
;; The murderous generals say to call it "Myanmar".
;; We will call it "Burma". -- rms, Chief GNUisance.
diff --git a/lisp/language/cham.el b/lisp/language/cham.el
index 4749f2e8db4..eef6d6f8f9f 100644
--- a/lisp/language/cham.el
+++ b/lisp/language/cham.el
@@ -1,4 +1,4 @@
-;;; cham.el --- support for Cham -*- coding: utf-8 -*-
+;;; cham.el --- support for Cham -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 2008, 2009, 2010, 2011, 2012
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el
index bc6969c1398..4389db961d8 100644
--- a/lisp/language/chinese.el
+++ b/lisp/language/chinese.el
@@ -103,6 +103,11 @@
(define-coding-system-alias 'hz-gb-2312 'chinese-hz)
(define-coding-system-alias 'hz 'chinese-hz)
+;; FIXME: 'define-coding-system' automatically sets :ascii-compatible-p,
+;; to any encoding whose :coding-type is 'utf-8', but UTF-7 is not ASCII
+;; compatible, so we override that here (bug#40407).
+(coding-system-put 'chinese-hz :ascii-compatible-p nil)
+
(set-language-info-alist
"Chinese-GB" '((charset chinese-gb2312 chinese-sisheng)
(iso639-language . zh)
diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el
index a3a6f3fdd94..ce60d1a3ad4 100644
--- a/lisp/language/cyril-util.el
+++ b/lisp/language/cyril-util.el
@@ -47,7 +47,7 @@
;;;###autoload
(defun standard-display-cyrillic-translit (&optional cyrillic-language)
- "Display a cyrillic buffer using a transliteration.
+ "Display a Cyrillic buffer using a transliteration.
For readability, the table is slightly
different from the one used for the input method `cyrillic-translit'.
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el
index 9847ab66e60..c19637010a2 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -169,13 +169,6 @@ Support for Russian using koi8-r and the russian-computer input method.")
:charset-list '(ibm866)
:mime-charset 'cp866)
-(define-coding-system 'koi8-u
- "KOI8-U 8-bit encoding for Cyrillic (MIME: KOI8-U)"
- :coding-type 'charset
- :mnemonic ?U
- :charset-list '(koi8-u)
- :mime-charset 'koi8-u)
-
(define-coding-system 'koi8-t
"KOI8-T 8-bit encoding for Cyrillic"
:coding-type 'charset
diff --git a/lisp/language/czech.el b/lisp/language/czech.el
index b3cc152d25e..e6923426b52 100644
--- a/lisp/language/czech.el
+++ b/lisp/language/czech.el
@@ -1,4 +1,4 @@
-;;; czech.el --- support for Czech -*- coding: utf-8 -*-
+;;; czech.el --- support for Czech -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/language/georgian.el b/lisp/language/georgian.el
index 3e3c1df31a0..53c994bd76f 100644
--- a/lisp/language/georgian.el
+++ b/lisp/language/georgian.el
@@ -1,4 +1,4 @@
-;;; georgian.el --- language support for Georgian
+;;; georgian.el --- language support for Georgian -*- lexical-binding: t -*-
;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/language/greek.el b/lisp/language/greek.el
index 2fec52637be..15ae5f42f94 100644
--- a/lisp/language/greek.el
+++ b/lisp/language/greek.el
@@ -1,4 +1,4 @@
-;;; greek.el --- support for Greek
+;;; greek.el --- support for Greek -*- lexical-binding: t -*-
;; Copyright (C) 2002, 2013-2020 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el
index 19cba91556b..f38dead5a23 100644
--- a/lisp/language/hanja-util.el
+++ b/lisp/language/hanja-util.el
@@ -22,7 +22,7 @@
;;; Commentary:
-;; This file defines korean hanja table and symbol table.
+;; This file defines the Korean Hanja table and symbol table.
;;; Code:
@@ -31,7 +31,7 @@
(defvar hanja-table nil
"A char table for Hanja characters.
-It maps a hangul character to a list of the corresponding Hanja characters.
+It maps a Hangul character to a list of the corresponding Hanja characters.
Each element of the list has the form CHAR or (CHAR . STRING)
where CHAR is a Hanja character and STRING is the meaning of that
character. This variable is initialized by `hanja-init-load'.")
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 573541aec16..08b70abfc29 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -240,7 +240,7 @@ Bidirectional editing is supported.")))
(let* ((base "[\u05D0-\u05F2\uFB1D\uFB1F-\uFB28\uFB2A-\uFB4F]")
(combining
- "[\u0591-\u05BD\u05BF\u05C1-\u05C2\u05C4-\u05C5\u05C7\uFB1E]+")
+ "[\u034F\u0591-\u05BD\u05BF\u05C1-\u05C2\u05C4-\u05C5\u05C7\uFB1E]+")
(pattern1 (concat base combining))
(pattern2 (concat base "\u200D" combining)))
(set-char-table-range
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 4319e5537e7..62885227f10 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -232,8 +232,8 @@
'(
(;; VOWELS
(?à´… nil) (?à´† ?à´¾) (?à´‡ ?à´¿) (?à´ˆ ?ീ) (?à´‰ ?àµ) (?à´Š ?ൂ)
- (?ഋ ?ൃ) (?ഌ nil) nil (?ഠ?േ) (?എ ?െ) (?ഠ?ൈ)
- nil (?ഓ ?ോ) (?ഒ ?ൊ) (?ഔ ?ൌ) nil nil)
+ (?ഋ ?ൃ) (?ഌ ?ൢ) (?ൡ ?ൣ) (?ഠ?േ) (?എ ?െ) (?ഠ?ൈ)
+ nil (?à´’ ?ൊ) (?à´“ ?ോ) (?à´” ?ൗ) (?ൠ?àµ) (?ൠ ?ൄ))
(;; CONSONANTS
?à´• ?à´– ?à´— ?à´˜ ?à´™ ;; GUTTRULS
?ച ?ഛ ?ജ ?ഠ?ഞ ;; PALATALS
@@ -243,13 +243,16 @@
?à´¯ ?à´° ?à´± ?à´² ?à´³ ?à´´ ?à´µ ;; SEMIVOWELS
?à´¶ ?à´· ?à´¸ ?à´¹ ;; SIBILANTS
nil nil nil nil nil nil nil nil ;; NUKTAS
- "à´œàµà´ž" "à´•àµà´·")
+ "à´œàµà´ž" "à´•àµà´·"
+ "à´±àµà´±" "à´¨àµà´±" "à´¤àµà´¤" "à´¤àµà´¥" "à´žàµà´ž" "à´™àµà´™" "à´¨àµà´¨"
+ "à´žàµà´š" "à´¨àµà´•" "à´™àµà´•" "à´šàµà´š" "à´šàµà´›" "à´•àµà´•"
+ "à´¬àµà´¬" "à´•àµà´•" "à´—àµà´—" "à´œàµà´œ" "à´®àµà´®" "à´ªàµà´ª" "à´µàµà´µ" "à´•àµà´¸" "à´¶àµà´¶")
(;; Misc Symbols
nil ?ം ?ഃ nil ?ൠnil nil)
(;; Digits
?൦ ?൧ ?൨ ?൩ ?൪ ?൫ ?൬ ?൭ ?൮ ?൯)
- (;; Inscript-extra (4) (#, $, ^, *, ])
- "àµà´°" "à´°àµ" "à´¤àµà´°" "à´¶àµà´°" nil)))
+ (;; Chillus
+ "à´£àµ" ?ൺ "à´¨àµ" ?ൻ "à´°àµ" ?ർ "à´²àµ" ?ൽ "à´³àµ" ?ൾ)))
(defvar indian-tml-base-table
'(
@@ -323,6 +326,29 @@
(;; misc -- 7
".N" (".n" "M") "H" ".a" ".h" ("AUM" "OM") "..")))
+(defvar indian-mlm-mozhi-table
+ '(;; for encode/decode
+ (;; vowels -- 18
+ "a" ("aa" "A") "i" ("ii" "I") "u" ("uu" "U")
+ "R" "Ll" "Lll" ("E" "ae") "e" "ai"
+ nil "o" "O" "au" "~" "RR")
+ (;; consonants -- 40
+ ("k" "c") "kh" "g" "gh" "ng"
+ "ch" ("Ch" "chh") "j" "jh" "nj"
+ "T" "Th" "D" "Dh" "N"
+ "th" "thh" "d" "dh" "n" nil
+ "p" ("ph" "f") "b" "bh" "m"
+ "y" "r" "rr" "l" "L" "zh" ("v" "w")
+ ("S" "z") "sh" "s" "h"
+ nil nil nil nil nil nil nil nil
+ nil "X"
+ ;; some of these are extra to Mozhi
+ ("t" "tt") "nt" "tth" "tthh" "nnj" "nng" "nn"
+ "nch" "nc" "nk" "cch" "cchh" "cc"
+ "B" ("C" "K" "q") "G" "J" "M" "P" "V" "x" "Z")
+ (;; misc -- 7
+ nil nil "H")))
+
(defvar indian-kyoto-harvard-table
'(;; for encode/decode
(;; vowel
@@ -524,6 +550,10 @@
(indian-make-hash indian-mlm-base-table
indian-itrans-v5-table))
+(defvar indian-mlm-mozhi-hash
+ (indian-make-hash indian-mlm-base-table
+ indian-mlm-mozhi-table))
+
(defvar indian-tml-itrans-v5-hash
(indian-make-hash indian-tml-base-table
indian-itrans-v5-table-for-tamil))
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index eb882c810e1..657ad6915eb 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -25,7 +25,7 @@
;;; Commentary:
;; This file contains definitions of Indian language environments, and
-;; setups for displaying the scrtipts used there.
+;; setups for displaying the scripts used there.
;;; Code:
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index d77efa48c9b..9a99245dfde 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -82,9 +82,7 @@
(#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE
)))
(define-translation-table 'japanese-ucs-jis-to-cp932-map map)
- (mapc #'(lambda (x) (let ((tmp (car x)))
- (setcar x (cdr x)) (setcdr x tmp)))
- map)
+ (setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map))
(define-translation-table 'japanese-ucs-cp932-to-jis-map map))
;; U+2014 (EM DASH) vs U+2015 (HORIZONTAL BAR)
@@ -241,8 +239,10 @@ eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>."
(#x2b65 . [#x02E9 #x02E5])
(#x2b66 . [#x02E5 #x02E9])))
table)
- (dolist (elt map)
- (setcar elt (decode-char 'japanese-jisx0213-1 (car elt))))
+ (setq map
+ (mapcar (lambda (x) (cons (decode-char 'japanese-jisx0213-1 (car x))
+ (cdr x)))
+ map))
(setq table (make-translation-table-from-alist map))
(define-translation-table 'jisx0213-to-unicode table)
(define-translation-table 'unicode-to-jisx0213
diff --git a/lisp/language/khmer.el b/lisp/language/khmer.el
index 4a070321961..37173c9fb95 100644
--- a/lisp/language/khmer.el
+++ b/lisp/language/khmer.el
@@ -1,4 +1,4 @@
-;;; khmer.el --- support for Khmer -*- coding: utf-8 -*-
+;;; khmer.el --- support for Khmer -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index 296dbd78970..3821785da73 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -46,7 +46,7 @@
(concat "korean-hangul" default-korean-keyboard))))
(defun quail-hangul-switch-symbol-ksc (&rest ignore)
- "Swith to/from Korean symbol package."
+ "Switch to/from Korean symbol package."
(interactive "i")
(and current-input-method
(if (string-equal current-input-method "korean-symbol")
@@ -55,7 +55,7 @@
(activate-input-method "korean-symbol"))))
(defun quail-hangul-switch-hanja (&rest ignore)
- "Swith to/from Korean hanja package."
+ "Switch to/from Korean hanja package."
(interactive "i")
(and current-input-method
(if (string-match "korean-hanja" current-input-method)
diff --git a/lisp/language/korean.el b/lisp/language/korean.el
index 210d0fabaf7..7e758159a48 100644
--- a/lisp/language/korean.el
+++ b/lisp/language/korean.el
@@ -84,6 +84,18 @@ and the following key bindings are available within Korean input methods:
F9, Hangul_Hanja: hangul-to-hanja-conversion")
))
+;; For auto-composing conjoining jamo.
+(let* ((choseong "[\u1100-\u115F\uA960-\uA97C]")
+ (jungseong "[\u1160-\u11A7\uD7B0-\uD7C6]")
+ (jongseong "[\u11A8-\u11FF\uD7CB-\uD7FB]?")
+ (pattern (concat choseong jungseong jongseong)))
+ (set-char-table-range composition-function-table
+ '(#x1100 . #x115F)
+ (list (vector pattern 0 'font-shape-gstring)))
+ (set-char-table-range composition-function-table
+ '(#xA960 . #xA97C)
+ (list (vector pattern 0 'font-shape-gstring))))
+
(provide 'korean)
;;; korean.el ends here
diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el
index a20aecee421..fa4c2f7f891 100644
--- a/lisp/language/lao-util.el
+++ b/lisp/language/lao-util.el
@@ -183,7 +183,9 @@
;; Semi-vowel-sign-lo and lower vowels are put under the letter.
(defconst lao-transcription-consonant-alist
- (sort '(;; single consonants
+ (sort
+ (copy-sequence
+ '(;; single consonants
("k" . "àº")
("kh" . "ຂ")
("qh" . "ຄ")
@@ -223,14 +225,16 @@
("hy" . ["ຫàº"])
("hn" . ["ຫນ"])
("hm" . ["ຫມ"])
- )
- (function (lambda (x y) (> (length (car x)) (length (car y)))))))
+ ))
+ (lambda (x y) (> (length (car x)) (length (car y))))))
(defconst lao-transcription-semi-vowel-alist
'(("r" . "ຼ")))
(defconst lao-transcription-vowel-alist
- (sort '(("a" . "ະ")
+ (sort
+ (copy-sequence
+ '(("a" . "ະ")
("ar" . "າ")
("i" . "ິ")
("ii" . "ີ")
@@ -257,8 +261,8 @@
("ai" . "ໄ")
("ei" . "ໃ")
("ao" . ["ເົາ"])
- ("aM" . "ຳ"))
- (function (lambda (x y) (> (length (car x)) (length (car y)))))))
+ ("aM" . "ຳ")))
+ (lambda (x y) (> (length (car x)) (length (car y))))))
;; Maa-sakod is put at the tail.
(defconst lao-transcription-maa-sakod-alist
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index e25e63b4c5c..089b79c5208 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -136,10 +136,63 @@ thin (i.e. 1-dot width) space."
(set-char-table-range
composition-function-table
'(#x600 . #x74F)
- (list (vector "[\u0600-\u074F\u200C\u200D]+" 0
- 'arabic-shape-gstring)
- (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+" 1
- 'arabic-shape-gstring)))
+ (list (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+"
+ 1 'arabic-shape-gstring)
+ (vector "[\u0600-\u074F\u200C\u200D]+"
+ 0 'arabic-shape-gstring)))
+
+;; The Egyptian Hieroglyph Format Controls were introduced in Unicode
+;; Standard v12.0. Apparently, they are not yet well supported in
+;; existing fonts, as of late 2020. But there's no reason for us not
+;; to be ready for when they will be!
+;; The below is needed to support the arrangement of the Egyptian
+;; Hieroglyphs in "quadrats", as directed by the format controls,
+;; which specify how the hieroglyphs should be joined horizontally and
+;; vertically.
+(defun egyptian-shape-grouping (gstring direction)
+ (if (= (lgstring-char gstring 0) #x13437)
+ (let ((nchars (lgstring-char-len gstring))
+ (i 1)
+ (nesting 1)
+ ch)
+ ;; Find where this group ends.
+ (while (and (< i nchars) (> nesting 0))
+ (setq ch (lgstring-char gstring i))
+ (cond
+ ((= ch #x13437)
+ (setq nesting (1+ nesting)))
+ ((= ch #x13438)
+ (setq nesting (1- nesting))))
+ (setq i (1+ i)))
+ (when (zerop nesting)
+ ;; Make a new gstring from the characters that constitute a
+ ;; complete nested group.
+ (let ((new-header (make-vector (1+ i) nil))
+ (new-gstring (make-vector (+ i 2) nil)))
+ (aset new-header 0 (lgstring-font gstring))
+ (dotimes (j i)
+ (aset new-header (1+ j) (lgstring-char gstring j))
+ (lgstring-set-glyph new-gstring j (lgstring-glyph gstring j)))
+ (lgstring-set-header new-gstring new-header)
+ (font-shape-gstring new-gstring direction))))))
+
+(let ((hieroglyph "[\U00013000-\U0001342F]"))
+ ;; HORIZONTAL/VERTICAL JOINER and INSERT AT.../OVERLAY controls
+ (set-char-table-range
+ composition-function-table
+ '(#x13430 . #x13436)
+ (list (vector (concat hieroglyph "[\U00013430-\U00013436]" hieroglyph)
+ ;; We use font-shape-gstring so that, if the font
+ ;; doesn't support these controls, the glyphs are
+ ;; displayed individually, and not as a single
+ ;; grapheme cluster.
+ 1 'font-shape-gstring)))
+ ;; Grouping controls
+ (set-char-table-range
+ composition-function-table
+ #x13437
+ (list (vector "\U00013437[\U00013000-\U0001343F]+"
+ 0 'egyptian-shape-grouping))))
(provide 'misc-lang)
diff --git a/lisp/language/romanian.el b/lisp/language/romanian.el
index 0cd1d61de0f..9f1c67765e1 100644
--- a/lisp/language/romanian.el
+++ b/lisp/language/romanian.el
@@ -1,4 +1,4 @@
-;;; romanian.el --- support for Romanian -*- coding: utf-8 -*-
+;;; romanian.el --- support for Romanian -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/language/sinhala.el b/lisp/language/sinhala.el
index efd8aacc5ac..90fc41c1c41 100644
--- a/lisp/language/sinhala.el
+++ b/lisp/language/sinhala.el
@@ -1,4 +1,4 @@
-;;; sinhala.el --- support for Sinhala -*- coding: utf-8 -*-
+;;; sinhala.el --- support for Sinhala -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/slovak.el b/lisp/language/slovak.el
index bc70a05ad08..c42a872574d 100644
--- a/lisp/language/slovak.el
+++ b/lisp/language/slovak.el
@@ -1,4 +1,4 @@
-;;; slovak.el --- support for Slovak -*- coding: utf-8 -*-
+;;; slovak.el --- support for Slovak -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el
index 22295f39e52..039e478b162 100644
--- a/lisp/language/tai-viet.el
+++ b/lisp/language/tai-viet.el
@@ -1,4 +1,4 @@
-;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8 -*-
+;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
;; Copyright (C) 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index 29fff9175b7..04369f6af87 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -43,13 +43,17 @@
("་" . "་")
("༔" . "༔")
;; Yes these are dirty. But ...
- ("༎ ༎" . ,(compose-string "༎ ༎" 0 3 [?༎ (Br . Bl) ? (Br . Bl) ?༎]))
+ ("༎ ༎" . ,(compose-string (copy-sequence "༎ ༎")
+ 0 3 [?༎ (Br . Bl) ? (Br . Bl) ?༎]))
("༄༅༅" . ,(compose-string
- "à¿à¿‚à¿‚à¿‚" 0 4
+ (copy-sequence "à¿à¿‚à¿‚à¿‚") 0 4
[?à¿ (Br . Bl) ?à¿‚ (Br . Bl) ?à¿‚ (Br . Bl) ?à¿‚]))
- ("༄༅" . ,(compose-string "à¿à¿‚à¿‚" 0 3 [?à¿ (Br . Bl) ?à¿‚ (Br . Bl) ?à¿‚]))
- ("༆" . ,(compose-string "à¿à¿‚༙" 0 3 [?à¿ (Br . Bl) ?à¿‚ (br . tr) ?༙]))
- ("༄" . ,(compose-string "à¿à¿‚" 0 2 [?à¿ (Br . Bl) ?à¿‚]))))
+ ("༄༅" . ,(compose-string (copy-sequence "à¿à¿‚à¿‚")
+ 0 3 [?à¿ (Br . Bl) ?à¿‚ (Br . Bl) ?à¿‚]))
+ ("༆" . ,(compose-string (copy-sequence "à¿à¿‚༙")
+ 0 3 [?࿠(Br . Bl) ?࿂ (br . tr) ?༙]))
+ ("༄" . ,(compose-string (copy-sequence "à¿à¿‚")
+ 0 2 [?à¿ (Br . Bl) ?à¿‚]))))
;;;###autoload
(defun tibetan-char-p (ch)
@@ -271,7 +275,7 @@ The returned string has no composition information."
(compose-region from to components)))))))
(defvar tibetan-decompose-precomposition-alist
- (mapcar (function (lambda (x) (cons (string-to-char (cdr x)) (car x))))
+ (mapcar (lambda (x) (cons (string-to-char (cdr x)) (car x)))
tibetan-precomposition-rule-alist))
;;;###autoload
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index d31cd5cd528..bbd4729f6c5 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -326,7 +326,9 @@
(defconst tibetan-subjoined-transcription-alist
- (sort '(("+k" . "à¾")
+ (sort
+ (copy-sequence
+ '(("+k" . "à¾")
("+kh" . "ྑ")
("+g" . "ྒ")
("+gh" . "ྒྷ")
@@ -371,8 +373,8 @@
("+W" . "ྺ") ;; fixed form subscribed WA
("+Y" . "ྻ") ;; fixed form subscribed YA
("+R" . "ྼ") ;; fixed form subscribed RA
- )
- (lambda (x y) (> (length (car x)) (length (car y))))))
+ ))
+ (lambda (x y) (> (length (car x)) (length (car y))))))
;;;
;;; alist for Tibetan base consonant <-> subjoined consonant conversion.
diff --git a/lisp/language/utf-8-lang.el b/lisp/language/utf-8-lang.el
index 78fbae3c89d..9e59f61ee10 100644
--- a/lisp/language/utf-8-lang.el
+++ b/lisp/language/utf-8-lang.el
@@ -1,4 +1,4 @@
-;;; utf-8-lang.el --- generic UTF-8 language environment
+;;; utf-8-lang.el --- generic UTF-8 language environment -*- lexical-binding: t -*-
;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/language/vietnamese.el b/lisp/language/vietnamese.el
index cb282db0762..c1cef962865 100644
--- a/lisp/language/vietnamese.el
+++ b/lisp/language/vietnamese.el
@@ -1,4 +1,4 @@
-;;; vietnamese.el --- support for Vietnamese -*- coding: utf-8; -*-
+;;; vietnamese.el --- support for Vietnamese -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 1998, 2001-2020 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index bf653cf593e..f5ae3adf2eb 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -55,7 +55,7 @@ should return a grid vector array that is the new solution.
\(fn BREEDER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "5x5" '("5x5-")))
+(register-definition-prefixes "5x5" '("5x5-"))
;;;***
@@ -192,7 +192,7 @@ old-style time formats for entries are supported.
\(fn OTHER-LOG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "add-log" '("add-log-" "change-log-")))
+(register-definition-prefixes "add-log" '("add-log-" "change-log-"))
;;;***
@@ -329,7 +329,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
(function-put 'defadvice 'lisp-indent-function '2)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "advice" '("ad-")))
+(register-definition-prefixes "advice" '("ad-"))
;;;***
@@ -432,7 +432,7 @@ A replacement function for `newline-and-indent', aligning as it goes.
The alignment is done by calling `align' on the region that was
indented." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "align" '("align-")))
+(register-definition-prefixes "align" '("align-"))
;;;***
@@ -477,11 +477,11 @@ With value nil, inhibit any automatic allout-mode activation.")
(custom-autoload 'allout-auto-activation "allout" nil)
-(put 'allout-use-hanging-indents 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-use-hanging-indents 'safe-local-variable 'booleanp)
(put 'allout-reindent-bodies 'safe-local-variable (lambda (x) (memq x '(nil t text force))))
-(put 'allout-show-bodies 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-show-bodies 'safe-local-variable 'booleanp)
(put 'allout-header-prefix 'safe-local-variable 'stringp)
@@ -493,13 +493,13 @@ With value nil, inhibit any automatic allout-mode activation.")
(put 'allout-use-mode-specific-leader 'safe-local-variable (lambda (x) (or (memq x '(t nil allout-mode-leaders comment-start)) (stringp x))))
-(put 'allout-old-style-prefixes 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-old-style-prefixes 'safe-local-variable 'booleanp)
-(put 'allout-stylish-prefixes 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-stylish-prefixes 'safe-local-variable 'booleanp)
-(put 'allout-numbered-bullet 'safe-local-variable (if (fboundp 'string-or-null-p) 'string-or-null-p (lambda (x) (or (stringp x) (null x)))))
+(put 'allout-numbered-bullet 'safe-local-variable 'string-or-null-p)
-(put 'allout-file-xref-bullet 'safe-local-variable (if (fboundp 'string-or-null-p) 'string-or-null-p (lambda (x) (or (stringp x) (null x)))))
+(put 'allout-file-xref-bullet 'safe-local-variable 'string-or-null-p)
(put 'allout-presentation-padding 'safe-local-variable 'integerp)
@@ -511,10 +511,16 @@ Return t if `allout-mode' is active in current buffer." nil t)
(autoload 'allout-mode "allout" "\
Toggle Allout outline mode.
-If called interactively, enable Allout mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Allout mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\\<allout-mode-map-value>
Allout outline mode is a minor mode that provides extensive
@@ -788,7 +794,7 @@ for details on preparing Emacs for automatic allout activation.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "allout" '("allout-")))
+(register-definition-prefixes "allout" '("allout-"))
;;;***
@@ -821,15 +827,21 @@ See `allout-widgets-mode' for allout widgets mode features.")
(custom-autoload 'allout-widgets-auto-activation "allout-widgets" nil)
-(put 'allout-widgets-mode-inhibit 'safe-local-variable (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil)))))
+(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp)
(autoload 'allout-widgets-mode "allout-widgets" "\
Toggle Allout Widgets mode.
-If called interactively, enable Allout-Widgets mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Allout-Widgets mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Allout Widgets mode is an extension of Allout mode that provides
graphical decoration of outline structure. It is meant to
@@ -851,7 +863,7 @@ outline hot-spot navigation (see `allout-mode').
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "allout-widgets" '("allout-")))
+(register-definition-prefixes "allout-widgets" '("allout-"))
;;;***
@@ -874,7 +886,7 @@ directory, so that Emacs will know its current contents.
\(fn OPERATION &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ange-ftp" '("ange-ftp-" "ftp-error" "internal-ange-ftp-mode")))
+(register-definition-prefixes "ange-ftp" '("ange-ftp-" "ftp-error" "internal-ange-ftp-mode"))
;;;***
@@ -908,7 +920,7 @@ the buffer *Birthday-Present-for-Name*.
\(fn &optional NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "animate" '("animat")))
+(register-definition-prefixes "animate" '("animat"))
;;;***
@@ -934,7 +946,7 @@ This is a good function to put in `comint-output-filter-functions'.
\(fn IGNORED)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ansi-color" '("ansi-color-")))
+(register-definition-prefixes "ansi-color" '("ansi-color-"))
;;;***
@@ -969,7 +981,7 @@ Major mode for editing ANTLR grammar files.
Use ANTLR's convention for TABs according to `antlr-tab-offset-alist'.
Used in `antlr-mode'. Also a useful function in `java-mode-hook'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "antlr-mode" '("antlr-")))
+(register-definition-prefixes "antlr-mode" '("antlr-"))
;;;***
@@ -992,7 +1004,7 @@ ARG is positive, otherwise off.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "appt" '("appt-")))
+(register-definition-prefixes "appt" '("appt-"))
;;;***
@@ -1038,6 +1050,19 @@ will be buffer-local when set.
\(fn PATTERN &optional BUFFER)" t nil)
+(autoload 'apropos-function "apropos" "\
+Show functions that match PATTERN.
+
+PATTERN can be a word, a list of words (separated by spaces),
+or a regexp (using some regexp special characters). If it is a word,
+search for matches for that word as a substring. If it is a list of words,
+search for matches for any two (or more) of those words.
+
+This is the same as running `apropos-command' with a \\[universal-argument] prefix,
+or a non-nil `apropos-do-all' argument.
+
+\(fn PATTERN)" t nil)
+
(defalias 'command-apropos 'apropos-command)
(autoload 'apropos-command "apropos" "\
@@ -1076,7 +1101,7 @@ search for matches for any two (or more) of those words.
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil,
consider all symbols (if they match PATTERN).
-Returns list of symbols and documentation found.
+Return list of symbols and documentation found.
\(fn PATTERN &optional DO-ALL)" t nil)
@@ -1126,7 +1151,7 @@ Returns list of symbols and documentation found.
\(fn PATTERN &optional DO-ALL)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "apropos" '("apropos-")))
+(register-definition-prefixes "apropos" '("apropos-"))
;;;***
@@ -1148,7 +1173,7 @@ archive.
\(fn &optional FORCE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "arc-mode" '("arc")))
+(register-definition-prefixes "arc-mode" '("arc"))
;;;***
@@ -1221,21 +1246,26 @@ Entering array mode calls the function `array-mode-hook'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "array" '("array-" "current-line" "limit-index" "move-to-column-untabify" "untabify-backward")))
+(register-definition-prefixes "array" '("array-" "current-line" "limit-index" "move-to-column-untabify" "untabify-backward"))
;;;***
;;;### (autoloads nil "artist" "textmodes/artist.el" (0 0 0 0))
;;; Generated autoloads from textmodes/artist.el
-(push (purecopy '(artist 1 2 6)) package--builtin-versions)
(autoload 'artist-mode "artist" "\
Toggle Artist mode.
-If called interactively, enable Artist mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Artist mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Artist lets you draw lines, squares, rectangles and poly-lines,
ellipses and circles with your mouse and/or keyboard.
@@ -1434,7 +1464,7 @@ Keymap summary
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "artist" '("artist-")))
+(register-definition-prefixes "artist" '("artist-"))
;;;***
@@ -1463,7 +1493,7 @@ Special commands:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "asm-mode" '("asm-")))
+(register-definition-prefixes "asm-mode" '("asm-"))
;;;***
@@ -1487,7 +1517,7 @@ passwords are revealed when point moved into the password.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "auth-source" '("auth")))
+(register-definition-prefixes "auth-source" '("auth"))
;;;***
@@ -1514,7 +1544,7 @@ key2: value2
\(fn KEY ENTRY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "auth-source-pass" '("auth-source-pass-")))
+(register-definition-prefixes "auth-source-pass" '("auth-source-pass-"))
;;;***
@@ -1564,10 +1594,16 @@ or call the function `autoarg-kp-mode'.")
(autoload 'autoarg-kp-mode "autoarg" "\
Toggle Autoarg-KP mode, a global minor mode.
-If called interactively, enable Autoarg-Kp mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Autoarg-Kp mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\\<autoarg-kp-mode-map>
This is similar to `autoarg-mode' but rebinds the keypad keys
@@ -1577,7 +1613,7 @@ This is similar to `autoarg-mode' but rebinds the keypad keys
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoarg" '("autoarg-")))
+(register-definition-prefixes "autoarg" '("autoarg-"))
;;;***
@@ -1589,7 +1625,7 @@ Major mode for editing Autoconf configure.ac files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoconf" '("autoconf-")))
+(register-definition-prefixes "autoconf" '("autoconf-"))
;;;***
@@ -1620,17 +1656,23 @@ or call the function `auto-insert-mode'.")
(autoload 'auto-insert-mode "autoinsert" "\
Toggle Auto-insert mode, a global minor mode.
-If called interactively, enable Auto-Insert mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Auto-Insert mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Auto-insert mode is enabled, when new files are created you can
insert a template for the file depending on the mode of the buffer.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoinsert" '("auto-insert")))
+(register-definition-prefixes "autoinsert" '("auto-insert"))
;;;***
@@ -1668,21 +1710,36 @@ The function does NOT recursively descend into subdirectories of the
directory or directories specified.
In an interactive call, prompt for a default output file for the
-autoload definitions, and temporarily bind the variable
-`generated-autoload-file' to this value. When called from Lisp,
-use the existing value of `generated-autoload-file'. If any Lisp
-file binds `generated-autoload-file' as a file-local variable,
-write its autoloads into the specified file instead.
+autoload definitions. When called from Lisp, use the existing
+value of `generated-autoload-file'. If any Lisp file binds
+`generated-autoload-file' as a file-local variable, write its
+autoloads into the specified file instead.
\(fn &rest DIRS)" t nil)
+(make-obsolete 'update-directory-autoloads 'make-directory-autoloads '"28.1")
+
+(autoload 'make-directory-autoloads "autoload" "\
+Update autoload definitions for Lisp files in the directories DIRS.
+DIR can be either a single directory or a list of
+directories. (The latter usage is discouraged.)
+
+The autoloads will be written to OUTPUT-FILE. If any Lisp file
+binds `generated-autoload-file' as a file-local variable, write
+its autoloads into the specified file instead.
+
+The function does NOT recursively descend into subdirectories of the
+directory or directories specified.
+
+\(fn DIR OUTPUT-FILE)" t nil)
+
(autoload 'batch-update-autoloads "autoload" "\
Update loaddefs.el autoloads in batch mode.
Calls `update-directory-autoloads' on the command line arguments.
Definitions are written to `generated-autoload-file' (which
should be non-nil)." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autoload" '("autoload-" "generate" "make-autoload" "no-update-autoloads")))
+(register-definition-prefixes "autoload" '("autoload-" "batch-update-autoloads--summary" "generate" "make-autoload" "no-update-autoloads"))
;;;***
@@ -1692,10 +1749,16 @@ should be non-nil)." nil nil)
(autoload 'auto-revert-mode "autorevert" "\
Toggle reverting buffer when the file changes (Auto-Revert Mode).
-If called interactively, enable Auto-Revert mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Auto-Revert mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Auto-Revert Mode is a minor mode that affects only the current
buffer. When enabled, it reverts the buffer when the file on
@@ -1719,10 +1782,16 @@ This function is designed to be added to hooks, for example:
(autoload 'auto-revert-tail-mode "autorevert" "\
Toggle reverting tail of buffer when the file grows.
-If called interactively, enable Auto-Revert-Tail mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Auto-Revert-Tail mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Auto-Revert Tail Mode is enabled, the tail of the file is
constantly followed, as with the shell command `tail -f'. This
@@ -1760,10 +1829,16 @@ or call the function `global-auto-revert-mode'.")
(autoload 'global-auto-revert-mode "autorevert" "\
Toggle Global Auto-Revert Mode.
-If called interactively, enable Global Auto-Revert mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Global Auto-Revert mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Global Auto-Revert Mode is a global minor mode that reverts any
buffer associated with a file when the file changes on disk. Use
@@ -1784,7 +1859,7 @@ specifies in the mode line.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "autorevert" '("auto-revert-" "global-auto-revert-")))
+(register-definition-prefixes "autorevert" '("auto-revert-" "global-auto-revert-"))
;;;***
@@ -1792,7 +1867,7 @@ specifies in the mode line.
;;;;;; 0))
;;; Generated autoloads from emacs-lisp/avl-tree.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "avl-tree" '("avl-tree-")))
+(register-definition-prefixes "avl-tree" '("avl-tree-"))
;;;***
@@ -1832,7 +1907,7 @@ definition of \"random distance\".)
\(fn &optional MODE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "avoid" '("mouse-avoidance-")))
+(register-definition-prefixes "avoid" '("mouse-avoidance-"))
;;;***
@@ -1845,7 +1920,7 @@ definition of \"random distance\".)
Print a trace of Lisp function calls currently active.
Output stream used is value of `standard-output'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "backtrace" '("backtrace-")))
+(register-definition-prefixes "backtrace" '("backtrace-"))
;;;***
@@ -1865,7 +1940,7 @@ Run script using `bat-run' and `bat-run-args'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bat-mode" '("bat-")))
+(register-definition-prefixes "bat-mode" '("bat-"))
;;;***
@@ -1891,10 +1966,16 @@ or call the function `display-battery-mode'.")
(autoload 'display-battery-mode "battery" "\
Toggle battery status display in mode line (Display Battery mode).
-If called interactively, enable Display-Battery mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Display-Battery mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
The text displayed in the mode line is controlled by
`battery-mode-line-format' and `battery-status-function'.
@@ -1903,7 +1984,7 @@ seconds.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "battery" '("battery-")))
+(register-definition-prefixes "battery" '("battery-"))
;;;***
@@ -1951,14 +2032,14 @@ The return value is the value of the final form in BODY.
(function-put 'benchmark-progn 'lisp-indent-function '0)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "benchmark" '("benchmark-elapse")))
+(register-definition-prefixes "benchmark" '("benchmark-elapse"))
;;;***
;;;### (autoloads nil "bib-mode" "textmodes/bib-mode.el" (0 0 0 0))
;;; Generated autoloads from textmodes/bib-mode.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bib-mode" '("addbib" "bib-" "mark-bib" "return-key-bib" "unread-bib")))
+(register-definition-prefixes "bib-mode" '("addbib" "bib-" "mark-bib" "return-key-bib" "unread-bib"))
;;;***
@@ -2051,7 +2132,7 @@ A prefix arg negates the value of `bibtex-search-entry-globally'.
\(fn KEY &optional GLOBAL START DISPLAY)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bibtex" '("bibtex-")))
+(register-definition-prefixes "bibtex" '("bibtex-"))
;;;***
@@ -2064,14 +2145,14 @@ Major mode for editing BibTeX style files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bibtex-style" '("bibtex-style-")))
+(register-definition-prefixes "bibtex-style" '("bibtex-style-"))
;;;***
;;;### (autoloads nil "bindat" "emacs-lisp/bindat.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/bindat.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bindat" '("bindat-")))
+(register-definition-prefixes "bindat" '("bindat-"))
;;;***
@@ -2097,7 +2178,7 @@ Binhex decode region between START and END.
\(fn START END)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "binhex" '("binhex-")))
+(register-definition-prefixes "binhex" '("binhex-"))
;;;***
@@ -2218,7 +2299,7 @@ a reflection.
\(fn NUM)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "blackbox" '("bb-" "blackbox-")))
+(register-definition-prefixes "blackbox" '("bb-" "blackbox-"))
;;;***
@@ -2229,7 +2310,7 @@ a reflection.
(define-key ctl-x-r-map "M" 'bookmark-set-no-overwrite)
(define-key ctl-x-r-map "l" 'bookmark-bmenu-list)
-(defvar bookmark-map (let ((map (make-sparse-keymap))) (define-key map "x" 'bookmark-set) (define-key map "m" 'bookmark-set) (define-key map "M" 'bookmark-set-no-overwrite) (define-key map "j" 'bookmark-jump) (define-key map "g" 'bookmark-jump) (define-key map "o" 'bookmark-jump-other-window) (define-key map "5" 'bookmark-jump-other-frame) (define-key map "i" 'bookmark-insert) (define-key map "e" 'edit-bookmarks) (define-key map "f" 'bookmark-insert-location) (define-key map "r" 'bookmark-rename) (define-key map "d" 'bookmark-delete) (define-key map "l" 'bookmark-load) (define-key map "w" 'bookmark-write) (define-key map "s" 'bookmark-save) map) "\
+(defvar bookmark-map (let ((map (make-sparse-keymap))) (define-key map "x" 'bookmark-set) (define-key map "m" 'bookmark-set) (define-key map "M" 'bookmark-set-no-overwrite) (define-key map "j" 'bookmark-jump) (define-key map "g" 'bookmark-jump) (define-key map "o" 'bookmark-jump-other-window) (define-key map "5" 'bookmark-jump-other-frame) (define-key map "i" 'bookmark-insert) (define-key map "e" 'edit-bookmarks) (define-key map "f" 'bookmark-insert-location) (define-key map "r" 'bookmark-rename) (define-key map "d" 'bookmark-delete) (define-key map "D" 'bookmark-delete-all) (define-key map "l" 'bookmark-load) (define-key map "w" 'bookmark-write) (define-key map "s" 'bookmark-save) map) "\
Keymap containing bindings to bookmark functions.
It is not bound to any key by default: to bind it
so that you have a bookmark prefix, just use `global-set-key' and bind a
@@ -2382,6 +2463,13 @@ probably because we were called from there.
\(fn BOOKMARK-NAME &optional BATCH)" t nil)
+(autoload 'bookmark-delete-all "bookmark" "\
+Permanently delete all bookmarks.
+If optional argument NO-CONFIRM is non-nil, don't ask for
+confirmation.
+
+\(fn &optional NO-CONFIRM)" t nil)
+
(autoload 'bookmark-write "bookmark" "\
Write bookmarks to a file (reading the file name with the minibuffer)." t nil)
@@ -2423,6 +2511,10 @@ unique numeric suffixes \"<2>\", \"<3>\", etc.
\(fn FILE &optional OVERWRITE NO-MSG DEFAULT)" t nil)
+(autoload 'bookmark-bmenu-get-buffer "bookmark" "\
+Return the Bookmark List, building it if it doesn't exists.
+Don't affect the buffer ring order." nil nil)
+
(autoload 'bookmark-bmenu-list "bookmark" "\
Display a list of existing bookmarks.
The list is displayed in a buffer named `*Bookmark List*'.
@@ -2436,11 +2528,11 @@ deletion, or > if it is flagged for displaying." t nil)
(autoload 'bookmark-bmenu-search "bookmark" "\
Incremental search of bookmarks, hiding the non-matches as we go." t nil)
-(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (bindings--define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) (bindings--define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) (bindings--define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) (bindings--define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) (bindings--define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) (bindings--define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) (bindings--define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) (bindings--define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map))
+(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (bindings--define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) (bindings--define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) (bindings--define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) (bindings--define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) (bindings--define-key map [delete-all] '(menu-item "Delete all Bookmarks..." bookmark-delete-all :help "Delete all bookmarks from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) (bindings--define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) (bindings--define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) (bindings--define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) (bindings--define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map))
(defalias 'menu-bar-bookmark-map menu-bar-bookmark-map)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bookmark" '("bookmark-" "with-buffer-modified-unmodified")))
+(register-definition-prefixes "bookmark" '("bookmark-" "with-buffer-modified-unmodified"))
;;;***
@@ -2452,16 +2544,34 @@ Function to display the current buffer in a WWW browser.
This is used by the `browse-url-at-point', `browse-url-at-mouse', and
`browse-url-of-file' commands.
-If the value is not a function it should be a list of pairs
-\(REGEXP . FUNCTION). In this case the function called will be the one
-associated with the first REGEXP which matches the current URL. The
-function is passed the URL and any other args of `browse-url'. The last
-regexp should probably be \".\" to specify a default browser.
-
-Also see `browse-url-secondary-browser-function'.")
+Also see `browse-url-secondary-browser-function' and
+`browse-url-handlers'.")
(custom-autoload 'browse-url-browser-function "browse-url" t)
+(defvar browse-url-default-handlers '(("\\`mailto:" . browse-url--mailto) ("\\`man:" . browse-url--man) (browse-url--non-html-file-url-p . browse-url-emacs)) "\
+Like `browse-url-handlers' but populated by Emacs and packages.
+
+Emacs and external packages capable of browsing certain URLs
+should place their entries in this alist rather than
+`browse-url-handlers' which is reserved for the user.")
+
+(autoload 'browse-url-select-handler "browse-url" "\
+Return a handler of suitable for browsing URL.
+This searches `browse-url-handlers', and
+`browse-url-default-handlers' for a matching handler. Return nil
+if no handler is found.
+
+If KIND is given, the search is restricted to handlers whose
+function symbol has the symbol-property `browse-url-browser-kind'
+set to KIND.
+
+Currently, it also consults `browse-url-browser-function' first
+if it is set to an alist, although this usage is deprecated since
+Emacs 28.1 and will be removed in a future release.
+
+\(fn URL &optional KIND)" nil nil)
+
(autoload 'browse-url-of-file "browse-url" "\
Ask a WWW browser to display FILE.
Display the current buffer's file if FILE is nil or if called
@@ -2491,16 +2601,18 @@ Ask a WWW browser to display the current region.
Ask a WWW browser to load URL.
Prompt for a URL, defaulting to the URL at or before point.
Invokes a suitable browser function which does the actual job.
-The variable `browse-url-browser-function' says which browser function to
-use. If the URL is a mailto: URL, consult `browse-url-mailto-function'
-first, if that exists.
-The additional ARGS are passed to the browser function. See the doc
-strings of the actual functions, starting with `browse-url-browser-function',
-for information about the significance of ARGS (most of the functions
-ignore it).
-If ARGS are omitted, the default is to pass `browse-url-new-window-flag'
-as ARGS.
+The variables `browse-url-browser-function',
+`browse-url-handlers', and `browse-url-default-handlers'
+determine which browser function to use.
+
+The additional ARGS are passed to the browser function. See the
+doc strings of the actual functions, starting with
+`browse-url-browser-function', for information about the
+significance of ARGS (most of the functions ignore it).
+
+If ARGS are omitted, the default is to pass
+`browse-url-new-window-flag' as ARGS.
\(fn URL &rest ARGS)" t nil)
@@ -2512,6 +2624,15 @@ Optional prefix argument ARG non-nil inverts the value of the option
\(fn &optional ARG)" t nil)
+(autoload 'browse-url-with-browser-kind "browse-url" "\
+Browse URL with a browser of the given browser KIND.
+KIND is either `internal' or `external'.
+
+When called interactively, the default browser kind is the
+opposite of the browser kind of `browse-url-browser-function'.
+
+\(fn KIND URL &optional ARG)" t nil)
+
(autoload 'browse-url-at-mouse "browse-url" "\
Ask a WWW browser to load a URL clicked with the mouse.
The URL is the one around or before the position of the mouse click
@@ -2639,46 +2760,6 @@ used instead of `browse-url-new-window-flag'.
(make-obsolete 'browse-url-gnome-moz 'nil '"25.1")
-(autoload 'browse-url-mosaic "browse-url" "\
-Ask the XMosaic WWW browser to load URL.
-
-Default to the URL around or before point. The strings in variable
-`browse-url-mosaic-arguments' are also passed to Mosaic and the
-program is invoked according to the variable
-`browse-url-mosaic-program'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Mosaic window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-\(fn URL &optional NEW-WINDOW)" t nil)
-
-(make-obsolete 'browse-url-mosaic 'nil '"25.1")
-
-(autoload 'browse-url-cci "browse-url" "\
-Ask the XMosaic WWW browser to load URL.
-Default to the URL around or before point.
-
-This function only works for XMosaic version 2.5 or later. You must
-select `CCI' from XMosaic's File menu, set the CCI Port Address to the
-value of variable `browse-url-CCI-port', and enable `Accept requests'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new browser window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-\(fn URL &optional NEW-WINDOW)" t nil)
-
-(make-obsolete 'browse-url-cci 'nil '"25.1")
-
(autoload 'browse-url-conkeror "browse-url" "\
Ask the Conkeror WWW browser to load URL.
Default to the URL around or before point. Also pass the strings
@@ -2699,6 +2780,8 @@ NEW-WINDOW instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-conkeror 'nil '"28.1")
+
(autoload 'browse-url-w3 "browse-url" "\
Ask the w3 WWW browser to load URL.
Default to the URL around or before point.
@@ -2792,7 +2875,7 @@ from `browse-url-elinks-wrapper'.
\(fn URL &optional NEW-WINDOW)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "browse-url" '("browse-url-")))
+(register-definition-prefixes "browse-url" '("browse-url-"))
;;;***
@@ -2829,7 +2912,7 @@ name of buffer configuration.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bs" '("bs-")))
+(register-definition-prefixes "bs" '("bs-"))
;;;***
@@ -2850,7 +2933,7 @@ columns on its right towards the left.
\\[bubbles-set-game-difficult] sets the difficulty to difficult.
\\[bubbles-set-game-hard] sets the difficulty to hard." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bubbles" '("bubbles-")))
+(register-definition-prefixes "bubbles" '("bubbles-"))
;;;***
@@ -2865,24 +2948,36 @@ columns on its right towards the left.
(autoload 'bug-reference-mode "bug-reference" "\
Toggle hyperlinking bug references in the buffer (Bug Reference mode).
-If called interactively, enable Bug-Reference mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Bug-Reference mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
(autoload 'bug-reference-prog-mode "bug-reference" "\
Like `bug-reference-mode', but only buttonize in comments and strings.
-If called interactively, enable Bug-Reference-Prog mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Bug-Reference-Prog mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bug-reference" '("bug-reference-")))
+(register-definition-prefixes "bug-reference" '("bug-reference-"))
;;;***
@@ -2890,7 +2985,7 @@ ARG is `toggle'; disable the mode otherwise.
;;;;;; 0))
;;; Generated autoloads from emacs-lisp/byte-opt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "byte-opt" '("byte-" "disassemble-offset")))
+(register-definition-prefixes "byte-opt" '("byte-" "disassemble-offset"))
;;;***
@@ -2950,11 +3045,14 @@ that already has a `.elc' file.
Compile a file of Lisp code named FILENAME into a file of byte code.
The output file's name is generated by passing FILENAME to the
function `byte-compile-dest-file' (which see).
-With prefix arg (noninteractively: 2nd arg), LOAD the file after compiling.
The value is non-nil if there were no errors, nil if errors.
+See also `emacs-lisp-byte-compile-and-load'.
+
\(fn FILENAME &optional LOAD)" t nil)
+(set-advertised-calling-convention 'byte-compile-file '(filename) '"28.1")
+
(autoload 'compile-defun "bytecomp" "\
Compile and evaluate the current top-level form.
Print the result in the echo area.
@@ -3019,7 +3117,7 @@ and corresponding effects.
\(fn &optional ARG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bytecomp" '("batch-byte-compile-file" "byte-" "displaying-byte-compile-warnings" "emacs-lisp-" "no-byte-compile")))
+(register-definition-prefixes "bytecomp" '("batch-byte-compile-file" "byte-" "displaying-byte-compile-warnings" "emacs-lisp-" "no-byte-compile"))
;;;***
@@ -3027,7 +3125,7 @@ and corresponding effects.
;;;;;; 0))
;;; Generated autoloads from calendar/cal-bahai.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-bahai" '("calendar-bahai-" "diary-bahai-" "holiday-bahai")))
+(register-definition-prefixes "cal-bahai" '("calendar-bahai-" "diary-bahai-" "holiday-bahai"))
;;;***
@@ -3037,7 +3135,7 @@ and corresponding effects.
(put 'calendar-chinese-time-zone 'risky-local-variable t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-china" '("calendar-chinese-" "diary-chinese-" "holiday-chinese")))
+(register-definition-prefixes "cal-china" '("calendar-chinese-" "diary-chinese-" "holiday-chinese"))
;;;***
@@ -3045,7 +3143,7 @@ and corresponding effects.
;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-coptic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-coptic" '("calendar-" "diary-")))
+(register-definition-prefixes "cal-coptic" '("calendar-" "diary-"))
;;;***
@@ -3058,7 +3156,7 @@ and corresponding effects.
(put 'calendar-current-time-zone-cache 'risky-local-variable t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-dst" '("calendar-" "dst-")))
+(register-definition-prefixes "cal-dst" '("calendar-" "dst-"))
;;;***
@@ -3066,7 +3164,7 @@ and corresponding effects.
;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-french.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-french" '("calendar-french-" "diary-french-date")))
+(register-definition-prefixes "cal-french" '("calendar-french-" "diary-french-date"))
;;;***
@@ -3081,14 +3179,14 @@ from the cursor position.
\(fn DEATH-DATE START-YEAR END-YEAR)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-hebrew" '("calendar-hebrew-" "diary-hebrew-" "holiday-hebrew")))
+(register-definition-prefixes "cal-hebrew" '("calendar-hebrew-" "diary-hebrew-" "holiday-hebrew"))
;;;***
;;;### (autoloads nil "cal-html" "calendar/cal-html.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-html.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-html" '("cal-html-")))
+(register-definition-prefixes "cal-html" '("cal-html-"))
;;;***
@@ -3096,14 +3194,14 @@ from the cursor position.
;;;;;; 0))
;;; Generated autoloads from calendar/cal-islam.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-islam" '("calendar-islamic-" "diary-islamic-" "holiday-islamic")))
+(register-definition-prefixes "cal-islam" '("calendar-islamic-" "diary-islamic-" "holiday-islamic"))
;;;***
;;;### (autoloads nil "cal-iso" "calendar/cal-iso.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-iso.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-iso" '("calendar-iso-" "diary-iso-date")))
+(register-definition-prefixes "cal-iso" '("calendar-iso-" "diary-iso-date"))
;;;***
@@ -3111,7 +3209,7 @@ from the cursor position.
;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-julian.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-julian" '("calendar-" "diary-" "holiday-julian")))
+(register-definition-prefixes "cal-julian" '("calendar-" "diary-" "holiday-julian"))
;;;***
@@ -3119,21 +3217,21 @@ from the cursor position.
;;;;;; 0))
;;; Generated autoloads from calendar/cal-mayan.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-mayan" '("calendar-mayan-" "diary-mayan-date")))
+(register-definition-prefixes "cal-mayan" '("calendar-mayan-" "diary-mayan-date"))
;;;***
;;;### (autoloads nil "cal-menu" "calendar/cal-menu.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-menu.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-menu" '("cal")))
+(register-definition-prefixes "cal-menu" '("cal"))
;;;***
;;;### (autoloads nil "cal-move" "calendar/cal-move.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-move.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-move" '("calendar-")))
+(register-definition-prefixes "cal-move" '("calendar-"))
;;;***
@@ -3141,21 +3239,21 @@ from the cursor position.
;;;;;; 0 0))
;;; Generated autoloads from calendar/cal-persia.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-persia" '("calendar-persian-" "diary-persian-date")))
+(register-definition-prefixes "cal-persia" '("calendar-persian-" "diary-persian-date"))
;;;***
;;;### (autoloads nil "cal-tex" "calendar/cal-tex.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-tex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-tex" '("cal-tex-")))
+(register-definition-prefixes "cal-tex" '("cal-tex-"))
;;;***
;;;### (autoloads nil "cal-x" "calendar/cal-x.el" (0 0 0 0))
;;; Generated autoloads from calendar/cal-x.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cal-x" '("calendar-" "diary-frame")))
+(register-definition-prefixes "cal-x" '("calendar-" "diary-frame"))
;;;***
@@ -3243,248 +3341,224 @@ See Info node `(calc)Defining Functions'.
(function-put 'defmath 'doc-string-elt '3)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc" '("calc" "defcalcmodevar" "inexact-result" "math-" "var-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "calc-aent" "calc/calc-aent.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from calc/calc-aent.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-aent" '("calc" "math-")))
+(register-definition-prefixes "calc" '("calc" "defcalcmodevar" "inexact-result" "math-" "var-"))
;;;***
;;;### (autoloads nil "calc-alg" "calc/calc-alg.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-alg.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-alg" '("calc" "math-")))
+(register-definition-prefixes "calc-alg" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-arith" "calc/calc-arith.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-arith.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-arith" '("calc" "math-")))
+(register-definition-prefixes "calc-arith" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-bin" "calc/calc-bin.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-bin.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-bin" '("calc" "math-")))
+(register-definition-prefixes "calc-bin" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-comb" "calc/calc-comb.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-comb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-comb" '("calc" "math-")))
+(register-definition-prefixes "calc-comb" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-cplx" "calc/calc-cplx.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-cplx.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-cplx" '("calc" "math-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "calc-embed" "calc/calc-embed.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from calc/calc-embed.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-embed" '("calc-")))
+(register-definition-prefixes "calc-cplx" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-ext" "calc/calc-ext.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-ext.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-ext" '("calc" "math-" "var-")))
+(register-definition-prefixes "calc-ext" '("calc" "math-" "var-"))
;;;***
;;;### (autoloads nil "calc-fin" "calc/calc-fin.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-fin.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-fin" '("calc" "math-c")))
+(register-definition-prefixes "calc-fin" '("calc" "math-c"))
;;;***
;;;### (autoloads nil "calc-forms" "calc/calc-forms.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-forms.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-forms" '("calc" "math-" "var-TimeZone")))
+(register-definition-prefixes "calc-forms" '("calc" "math-" "var-TimeZone"))
;;;***
;;;### (autoloads nil "calc-frac" "calc/calc-frac.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-frac.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-frac" '("calc" "math-")))
+(register-definition-prefixes "calc-frac" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-funcs" "calc/calc-funcs.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-funcs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-funcs" '("calc" "math-")))
+(register-definition-prefixes "calc-funcs" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-graph" "calc/calc-graph.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-graph.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-graph" '("calc-")))
+(register-definition-prefixes "calc-graph" '("calc-"))
;;;***
;;;### (autoloads nil "calc-help" "calc/calc-help.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-help.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-help" '("calc-")))
+(register-definition-prefixes "calc-help" '("calc-"))
;;;***
;;;### (autoloads nil "calc-incom" "calc/calc-incom.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-incom.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-incom" '("calc-")))
+(register-definition-prefixes "calc-incom" '("calc-"))
;;;***
;;;### (autoloads nil "calc-keypd" "calc/calc-keypd.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-keypd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-keypd" '("calc-")))
+(register-definition-prefixes "calc-keypd" '("calc-"))
;;;***
;;;### (autoloads nil "calc-lang" "calc/calc-lang.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-lang.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-lang" '("calc-" "math-")))
+(register-definition-prefixes "calc-lang" '("calc-" "math-"))
;;;***
;;;### (autoloads nil "calc-macs" "calc/calc-macs.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-macs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-macs" '("Math-" "calc-" "math-")))
+(register-definition-prefixes "calc-macs" '("Math-" "calc-" "math-"))
;;;***
;;;### (autoloads nil "calc-map" "calc/calc-map.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-map.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-map" '("calc" "math-")))
+(register-definition-prefixes "calc-map" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-math" "calc/calc-math.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-math.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-math" '("calc" "math-")))
+(register-definition-prefixes "calc-math" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-menu" "calc/calc-menu.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-menu.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-menu" '("calc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "calc-misc" "calc/calc-misc.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from calc/calc-misc.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-misc" '("math-iipow")))
+(register-definition-prefixes "calc-menu" '("calc-"))
;;;***
;;;### (autoloads nil "calc-mode" "calc/calc-mode.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-mode.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-mode" '("calc-" "math-get-modes-vec")))
+(register-definition-prefixes "calc-mode" '("calc-" "math-get-modes-vec"))
;;;***
;;;### (autoloads nil "calc-mtx" "calc/calc-mtx.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-mtx.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-mtx" '("calc" "math-")))
+(register-definition-prefixes "calc-mtx" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-nlfit" "calc/calc-nlfit.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-nlfit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-nlfit" '("calc-fit-" "math-nlfit-")))
+(register-definition-prefixes "calc-nlfit" '("calc-fit-" "math-nlfit-"))
;;;***
;;;### (autoloads nil "calc-poly" "calc/calc-poly.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-poly.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-poly" '("calcFunc-" "math-")))
+(register-definition-prefixes "calc-poly" '("calcFunc-" "math-"))
;;;***
;;;### (autoloads nil "calc-prog" "calc/calc-prog.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-prog.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-prog" '("calc" "math-" "var-q")))
+(register-definition-prefixes "calc-prog" '("calc" "math-" "var-q"))
;;;***
;;;### (autoloads nil "calc-rewr" "calc/calc-rewr.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-rewr.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-rewr" '("calc" "math-")))
+(register-definition-prefixes "calc-rewr" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-rules" "calc/calc-rules.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-rules.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-rules" '("calc-")))
+(register-definition-prefixes "calc-rules" '("calc-"))
;;;***
;;;### (autoloads nil "calc-sel" "calc/calc-sel.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-sel.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-sel" '("calc-")))
+(register-definition-prefixes "calc-sel" '("calc-"))
;;;***
;;;### (autoloads nil "calc-stat" "calc/calc-stat.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-stat.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-stat" '("calc" "math-")))
+(register-definition-prefixes "calc-stat" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-store" "calc/calc-store.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-store.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-store" '("calc")))
+(register-definition-prefixes "calc-store" '("calc"))
;;;***
;;;### (autoloads nil "calc-stuff" "calc/calc-stuff.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-stuff.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-stuff" '("calc" "math-")))
+(register-definition-prefixes "calc-stuff" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-trail" "calc/calc-trail.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-trail.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-trail" '("calc-trail-")))
+(register-definition-prefixes "calc-trail" '("calc-trail-"))
;;;***
@@ -3496,57 +3570,49 @@ See Info node `(calc)Defining Functions'.
\(fn N)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-undo" '("calc-")))
+(register-definition-prefixes "calc-undo" '("calc-"))
;;;***
;;;### (autoloads nil "calc-units" "calc/calc-units.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-units.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-units" '("calc" "math-")))
+(register-definition-prefixes "calc-units" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calc-vec" "calc/calc-vec.el" (0 0 0 0))
;;; Generated autoloads from calc/calc-vec.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-vec" '("calc" "math-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "calc-yank" "calc/calc-yank.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from calc/calc-yank.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calc-yank" '("calc-" "math-number-regexp")))
+(register-definition-prefixes "calc-vec" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calcalg2" "calc/calcalg2.el" (0 0 0 0))
;;; Generated autoloads from calc/calcalg2.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calcalg2" '("calc" "math-" "var-IntegLimit")))
+(register-definition-prefixes "calcalg2" '("calc" "math-" "var-IntegLimit"))
;;;***
;;;### (autoloads nil "calcalg3" "calc/calcalg3.el" (0 0 0 0))
;;; Generated autoloads from calc/calcalg3.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calcalg3" '("calc" "math-")))
+(register-definition-prefixes "calcalg3" '("calc" "math-"))
;;;***
;;;### (autoloads nil "calccomp" "calc/calccomp.el" (0 0 0 0))
;;; Generated autoloads from calc/calccomp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calccomp" '("calcFunc-c" "math-")))
+(register-definition-prefixes "calccomp" '("calcFunc-c" "math-"))
;;;***
;;;### (autoloads nil "calcsel2" "calc/calcsel2.el" (0 0 0 0))
;;; Generated autoloads from calc/calcsel2.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calcsel2" '("calc-")))
+(register-definition-prefixes "calcsel2" '("calc-"))
;;;***
@@ -3557,7 +3623,7 @@ See Info node `(calc)Defining Functions'.
Run the Emacs calculator.
See the documentation for `calculator-mode' for more information." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calculator" '("calculator-")))
+(register-definition-prefixes "calculator" '("calculator-"))
;;;***
@@ -3601,7 +3667,7 @@ This function is suitable for execution in an init file.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "calendar" '("calendar-" "diary-" "holiday-buffer" "lunar-phases-buffer" "solar-sunrises-buffer")))
+(register-definition-prefixes "calendar" '("calendar-" "diary-" "holiday-buffer" "lunar-phases-buffer" "solar-sunrises-buffer"))
;;;***
@@ -3620,21 +3686,21 @@ it fails.
\(fn &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "canlock" '("canlock-")))
+(register-definition-prefixes "canlock" '("canlock-"))
;;;***
;;;### (autoloads nil "cc-align" "progmodes/cc-align.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-align.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-align" '("c-")))
+(register-definition-prefixes "cc-align" '("c-"))
;;;***
;;;### (autoloads nil "cc-awk" "progmodes/cc-awk.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-awk.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-awk" '("awk-" "c-awk-")))
+(register-definition-prefixes "cc-awk" '("awk-" "c-awk-"))
;;;***
@@ -3642,21 +3708,21 @@ it fails.
;;;;;; 0 0 0))
;;; Generated autoloads from progmodes/cc-bytecomp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-bytecomp" '("cc-")))
+(register-definition-prefixes "cc-bytecomp" '("cc-"))
;;;***
;;;### (autoloads nil "cc-cmds" "progmodes/cc-cmds.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-cmds.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-cmds" '("c-")))
+(register-definition-prefixes "cc-cmds" '("c-"))
;;;***
;;;### (autoloads nil "cc-defs" "progmodes/cc-defs.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-defs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-defs" '("c-" "cc-bytecomp-compiling-or-loading")))
+(register-definition-prefixes "cc-defs" '("c-" "cc-bytecomp-compiling-or-loading"))
;;;***
@@ -3667,14 +3733,14 @@ it fails.
(autoload 'c-guess-basic-syntax "cc-engine" "\
Return the syntactic context of the current line." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-engine" '("c-")))
+(register-definition-prefixes "cc-engine" '("c-"))
;;;***
;;;### (autoloads nil "cc-fonts" "progmodes/cc-fonts.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-fonts.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-fonts" '("autodoc-" "c++-font-lock-keywords" "c-" "gtkdoc-font-lock-" "idl-font-lock-keywords" "java" "objc-font-lock-keywords" "pike-font-lock-keywords")))
+(register-definition-prefixes "cc-fonts" '("autodoc-" "c++-font-lock-keywords" "c-" "doxygen-font-lock-" "gtkdoc-font-lock-" "idl-font-lock-keywords" "java" "objc-font-lock-keywords" "pike-font-lock-keywords"))
;;;***
@@ -3774,21 +3840,21 @@ the absolute file name of the file if STYLE-NAME is nil.
\(fn &optional STYLE-NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-guess" '("c-guess-")))
+(register-definition-prefixes "cc-guess" '("c-guess-"))
;;;***
;;;### (autoloads nil "cc-langs" "progmodes/cc-langs.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-langs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-langs" '("c-")))
+(register-definition-prefixes "cc-langs" '("c-"))
;;;***
;;;### (autoloads nil "cc-menus" "progmodes/cc-menus.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cc-menus.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-menus" '("cc-imenu-")))
+(register-definition-prefixes "cc-menus" '("cc-imenu-"))
;;;***
@@ -3843,7 +3909,7 @@ should be used.
This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
-`c-mode' or `c++-mode'." nil nil)
+`c-mode' or `c++-mode'." t nil)
(autoload 'c++-mode "cc-mode" "\
Major mode for editing C++ code.
@@ -3962,7 +4028,7 @@ Key bindings:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-mode" '("awk-mode-map" "c++-mode-" "c-" "idl-mode-" "java-mode-" "objc-mode-" "pike-mode-")))
+(register-definition-prefixes "cc-mode" '("awk-mode-map" "c++-mode-" "c-" "idl-mode-" "java-mode-" "objc-mode-" "pike-mode-"))
;;;***
@@ -4016,7 +4082,7 @@ and exists only for compatibility reasons.
\(fn SYMBOL OFFSET &optional IGNORED)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-styles" '("c-" "cc-choose-style-for-mode")))
+(register-definition-prefixes "cc-styles" '("c-" "cc-choose-style-for-mode"))
;;;***
@@ -4026,7 +4092,7 @@ and exists only for compatibility reasons.
(put 'c-backslash-column 'safe-local-variable 'integerp)
(put 'c-file-style 'safe-local-variable 'string-or-null-p)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cc-vars" '("awk-mode-hook" "c++-" "c-" "defcustom-c-stylevar" "idl-" "java-" "objc-" "pike-")))
+(register-definition-prefixes "cc-vars" '("awk-mode-hook" "c++-" "c-" "defcustom-c-stylevar" "idl-" "java-" "objc-" "pike-"))
;;;***
@@ -4321,7 +4387,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program.
\(fn CCL-PROG &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ccl" '("ccl-")))
+(register-definition-prefixes "ccl" '("ccl-"))
;;;***
@@ -4342,14 +4408,14 @@ Add the warnings that closure conversion would encounter.
\(fn FORM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cconv" '("cconv-")))
+(register-definition-prefixes "cconv" '("cconv-"))
;;;***
;;;### (autoloads nil "cdl" "cdl.el" (0 0 0 0))
;;; Generated autoloads from cdl.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cdl" '("cdl-")))
+(register-definition-prefixes "cdl" '("cdl-"))
;;;***
@@ -4357,7 +4423,7 @@ Add the warnings that closure conversion would encounter.
;;; Generated autoloads from cedet/cedet.el
(push (purecopy '(cedet 2 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet" '("cedet-")))
+(register-definition-prefixes "cedet" '("cedet-"))
;;;***
@@ -4365,7 +4431,7 @@ Add the warnings that closure conversion would encounter.
;;;;;; 0 0))
;;; Generated autoloads from cedet/cedet-cscope.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-cscope" '("cedet-cscope-")))
+(register-definition-prefixes "cedet-cscope" '("cedet-cscope-"))
;;;***
@@ -4373,7 +4439,7 @@ Add the warnings that closure conversion would encounter.
;;;;;; 0))
;;; Generated autoloads from cedet/cedet-files.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-files" '("cedet-")))
+(register-definition-prefixes "cedet-files" '("cedet-"))
;;;***
@@ -4381,7 +4447,7 @@ Add the warnings that closure conversion would encounter.
;;;;;; 0 0))
;;; Generated autoloads from cedet/cedet-global.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-global" '("cedet-g")))
+(register-definition-prefixes "cedet-global" '("cedet-g"))
;;;***
@@ -4389,7 +4455,7 @@ Add the warnings that closure conversion would encounter.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/cedet-idutils.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cedet-idutils" '("cedet-idutils-")))
+(register-definition-prefixes "cedet-idutils" '("cedet-idutils-"))
;;;***
@@ -4418,7 +4484,7 @@ to the action header.
(autoload 'cfengine-auto-mode "cfengine" "\
Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cfengine" '("cfengine")))
+(register-definition-prefixes "cfengine" '("cfengine"))
;;;***
@@ -4445,15 +4511,14 @@ from which to start.
\(fn STRING &optional LAX FROM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "char-fold" '("char-fold-")))
+(register-definition-prefixes "char-fold" '("char-fold-"))
;;;***
;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/chart.el
-(push (purecopy '(chart 0 2)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "chart" '("chart")))
+(register-definition-prefixes "chart" '("chart"))
;;;***
@@ -4473,14 +4538,13 @@ Returns non-nil if any false statements are found.
\(fn ROOT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "check-declare" '("check-declare-")))
+(register-definition-prefixes "check-declare" '("check-declare-"))
;;;***
;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from emacs-lisp/checkdoc.el
-(push (purecopy '(checkdoc 0 6 2)) package--builtin-versions)
(put 'checkdoc-force-docstrings-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-force-history-flag 'safe-local-variable #'booleanp)
(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable #'booleanp)
@@ -4645,10 +4709,16 @@ Prefix argument is the same as for `checkdoc-defun'." t nil)
(autoload 'checkdoc-minor-mode "checkdoc" "\
Toggle automatic docstring checking (Checkdoc minor mode).
-If called interactively, enable Checkdoc minor mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Checkdoc minor mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
In Checkdoc minor mode, the usual bindings for `eval-defun' which is
bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
@@ -4661,7 +4731,7 @@ checking of documentation strings.
(autoload 'checkdoc-package-keywords "checkdoc" "\
Find package keywords that aren't in `finder-known-keywords'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "checkdoc" '("checkdoc-")))
+(register-definition-prefixes "checkdoc" '("checkdoc-"))
;;;***
@@ -4697,7 +4767,7 @@ Encode the text in the current buffer to HZ." t nil)
\(fn FROM TO)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "china-util" '("decode-hz-line-continuation" "hz-" "hz/zw-start-gb" "iso2022-" "zw-start-gb")))
+(register-definition-prefixes "china-util" '("decode-hz-line-continuation" "hz-" "hz/zw-start-gb" "iso2022-" "zw-start-gb"))
;;;***
@@ -4734,15 +4804,41 @@ and digits provide prefix arguments. Tab does not indent.
This command always recompiles the Command History listing
and runs the normal hook `command-history-hook'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "chistory" '("command-history-" "default-command-history-filter" "list-command-history-")))
+(register-definition-prefixes "chistory" '("command-history-" "default-command-history-filter" "list-command-history-"))
;;;***
-;;;### (autoloads "actual autoloads are elsewhere" "cl-extra" "emacs-lisp/cl-extra.el"
+;;;### (autoloads nil "cl-font-lock" "progmodes/cl-font-lock.el"
;;;;;; (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/cl-extra.el
+;;; Generated autoloads from progmodes/cl-font-lock.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-extra" '("cl-")))
+(defvar cl-font-lock-built-in-mode nil "\
+Non-nil if Cl-Font-Lock-Built-In mode is enabled.
+See the `cl-font-lock-built-in-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `cl-font-lock-built-in-mode'.")
+
+(custom-autoload 'cl-font-lock-built-in-mode "cl-font-lock" nil)
+
+(autoload 'cl-font-lock-built-in-mode "cl-font-lock" "\
+Highlight built-in functions, variables, and types in `lisp-mode'.
+
+If called interactively, toggle `Cl-Font-Lock-Built-In mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+\(fn &optional ARG)" t nil)
+
+(register-definition-prefixes "cl-font-lock" '("cl-font-lock-"))
;;;***
@@ -4818,7 +4914,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
\(fn GENERIC QUALIFIERS SPECIALIZERS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-generic" '("cl-")))
+(register-definition-prefixes "cl-generic" '("cl-"))
;;;***
@@ -4904,7 +5000,7 @@ instead.
\(fn INDENT-POINT STATE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-indent" '("common-lisp-" "lisp-")))
+(register-definition-prefixes "cl-indent" '("common-lisp-" "lisp-"))
;;;***
@@ -4947,22 +5043,20 @@ This can be needed when using code byte-compiled using the old
macro-expansion of `cl-defstruct' that used vectors objects instead
of record objects.
-If called interactively, enable Cl-Old-Struct-Compat mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Cl-Old-Struct-Compat mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
-\(fn &optional ARG)" t nil)
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-lib" '("cl-")))
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "cl-macs" "emacs-lisp/cl-macs.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/cl-macs.el
+\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-macs" '("cl-")))
+(register-definition-prefixes "cl-lib" '("cl-"))
;;;***
@@ -5018,15 +5112,7 @@ limit.
\(fn PRINT-FUNCTION VALUE LIMIT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-print" '("cl-print-" "help-byte-code")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "cl-seq" "emacs-lisp/cl-seq.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/cl-seq.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-seq" '("cl--")))
+(register-definition-prefixes "cl-print" '("cl-print-" "help-byte-code"))
;;;***
@@ -5048,7 +5134,7 @@ For use inside Lisp programs, see also `c-macro-expansion'.
\(fn START END SUBST)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cmacexp" '("c-macro-")))
+(register-definition-prefixes "cmacexp" '("c-macro-"))
;;;***
@@ -5070,7 +5156,7 @@ is run).
\(fn CMD)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cmuscheme" '("cmuscheme-load-hook" "inferior-scheme-" "scheme-" "switch-to-scheme")))
+(register-definition-prefixes "cmuscheme" '("cmuscheme-load-hook" "inferior-scheme-" "scheme-" "switch-to-scheme"))
;;;***
@@ -5091,7 +5177,7 @@ If FRAME cannot display COLOR, return nil.
\(fn COLOR &optional FRAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "color" '("color-")))
+(register-definition-prefixes "color" '("color-"))
;;;***
@@ -5199,7 +5285,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use.
\(fn PROCESS COMMAND REGEXP REGEXP-GROUP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "comint" '("comint-")))
+(register-definition-prefixes "comint" '("comint-"))
;;;***
@@ -5237,14 +5323,14 @@ on third call it again advances points to the next difference and so on.
\(fn IGNORE-WHITESPACE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compare-w" '("compare-")))
+(register-definition-prefixes "compare-w" '("compare-"))
;;;***
;;;### (autoloads nil "compface" "image/compface.el" (0 0 0 0))
;;; Generated autoloads from image/compface.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compface" '("uncompface")))
+(register-definition-prefixes "compface" '("uncompface"))
;;;***
@@ -5396,10 +5482,16 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
(autoload 'compilation-shell-minor-mode "compile" "\
Toggle Compilation Shell minor mode.
-If called interactively, enable Compilation-Shell minor mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Compilation-Shell minor mode'. If
+the prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Compilation Shell minor mode is enabled, all the
error-parsing commands of the Compilation major mode are
@@ -5411,10 +5503,16 @@ See `compilation-mode'.
(autoload 'compilation-minor-mode "compile" "\
Toggle Compilation minor mode.
-If called interactively, enable Compilation minor mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Compilation minor mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Compilation minor mode is enabled, all the error-parsing
commands of Compilation major mode are available. See
@@ -5428,7 +5526,7 @@ This is the value of `next-error-function' in Compilation buffers.
\(fn N &optional RESET)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compile" '("compil" "define-compilation-mode" "kill-compilation" "recompile")))
+(register-definition-prefixes "compile" '("compil" "define-compilation-mode" "kill-compilation" "recompile"))
;;;***
@@ -5448,14 +5546,20 @@ or call the function `dynamic-completion-mode'.")
(autoload 'dynamic-completion-mode "completion" "\
Toggle dynamic word-completion on or off.
-If called interactively, enable Dynamic-Completion mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Dynamic-Completion mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "completion" '("*c-def-regexp*" "*lisp-def-regexp*" "accept-completion" "add-" "cdabbrev-" "check-completion-length" "clear-all-completions" "cmpl-" "complet" "current-completion-source" "delete-completion" "enable-completion" "find-" "initialize-completions" "inside-locate-completion-entry" "interactive-completion-string-reader" "kill-" "list-all-completions" "load-completions-from-file" "make-c" "next-cdabbrev" "num-cmpl-sources" "reset-cdabbrev" "save" "set-c" "symbol-" "use-completion-")))
+(register-definition-prefixes "completion" '("*c-def-regexp*" "*lisp-def-regexp*" "accept-completion" "add-" "cdabbrev-" "check-completion-length" "clear-all-completions" "cmpl-" "complet" "current-completion-source" "delete-completion" "enable-completion" "find-" "initialize-completions" "inside-locate-completion-entry" "interactive-completion-string-reader" "kill-" "list-all-completions" "load-completions-from-file" "make-c" "next-cdabbrev" "num-cmpl-sources" "reset-cdabbrev" "save" "set-c" "symbol-" "use-completion-"))
;;;***
@@ -5492,7 +5596,9 @@ doesn't have enough contents to decide, this is identical to
See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode',
`conf-ppd-mode' and `conf-xdefaults-mode'.
-\\{conf-mode-map}" t nil)
+\\{conf-mode-map}
+
+\(fn)" t nil)
(autoload 'conf-unix-mode "conf-mode" "\
Conf Mode starter for Unix style Conf files.
@@ -5628,7 +5734,7 @@ For details see `conf-mode'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "conf-mode" '("conf-")))
+(register-definition-prefixes "conf-mode" '("conf-"))
;;;***
@@ -5658,7 +5764,7 @@ and subsequent calls on the same file won't go to disk.
\(fn PHRASE-FILE &optional STARTMSG ENDMSG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cookie1" '("cookie")))
+(register-definition-prefixes "cookie1" '("cookie"))
;;;***
@@ -5697,7 +5803,7 @@ If FIX is non-nil, run `copyright-fix-years' instead.
\(fn DIRECTORY MATCH &optional FIX)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "copyright" '("copyright-")))
+(register-definition-prefixes "copyright" '("copyright-"))
;;;***
@@ -5855,12 +5961,12 @@ Variables controlling indentation style:
`cperl-min-label-indent'
Minimal indentation for line that is a label.
-Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith
- `cperl-indent-level' 5 4 2 4
- `cperl-brace-offset' 0 0 0 0
- `cperl-continued-brace-offset' -5 -4 0 0
- `cperl-label-offset' -5 -4 -2 -4
- `cperl-continued-statement-offset' 5 4 2 4
+Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith
+ `cperl-indent-level' 5 4 2 4 4
+ `cperl-brace-offset' 0 0 0 0 0
+ `cperl-continued-brace-offset' -5 -4 0 0 0
+ `cperl-label-offset' -5 -4 -2 -2 -4
+ `cperl-continued-statement-offset' 5 4 2 4 4
CPerl knows several indentation styles, and may bulk set the
corresponding variables. Use \\[cperl-set-style] to do this. Use
@@ -5896,7 +6002,7 @@ Run `perldoc' on WORD.
(autoload 'cperl-perldoc-at-point "cperl-mode" "\
Run a `perldoc' on the word around point." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cperl-mode" '("cperl-" "pod2man-program")))
+(register-definition-prefixes "cperl-mode" '("cperl-" "pod2man-program"))
;;;***
@@ -5914,7 +6020,7 @@ A prefix arg suppresses display of that buffer.
(autoload 'cpp-parse-edit "cpp" "\
Edit display information for cpp conditionals." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cpp" '("cpp-")))
+(register-definition-prefixes "cpp" '("cpp-"))
;;;***
@@ -5942,7 +6048,7 @@ with empty strings removed.
\(fn PROMPT TABLE &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "crm" '("crm-")))
+(register-definition-prefixes "crm" '("crm-"))
;;;***
@@ -5987,7 +6093,7 @@ on what is seen near point.
\(fn SYMBOL)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "css-mode" '("css-" "scss-")))
+(register-definition-prefixes "css-mode" '("css-" "scss-"))
;;;***
@@ -6007,10 +6113,16 @@ or call the function `cua-mode'.")
(autoload 'cua-mode "cua-base" "\
Toggle Common User Access style editing (CUA mode).
-If called interactively, enable Cua mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Cua mode'. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
CUA mode is a global minor mode. When enabled, typed text
replaces the active selection, and you can use C-z, C-x, C-c, and
@@ -6037,14 +6149,14 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-base" '("cua-")))
+(register-definition-prefixes "cua-base" '("cua-"))
;;;***
;;;### (autoloads nil "cua-gmrk" "emulation/cua-gmrk.el" (0 0 0 0))
;;; Generated autoloads from emulation/cua-gmrk.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-gmrk" '("cua-")))
+(register-definition-prefixes "cua-gmrk" '("cua-"))
;;;***
@@ -6055,14 +6167,20 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings.
Toggle the region as rectangular.
Activates the region if needed. Only lasts until the region is deactivated.
-If called interactively, enable Cua-Rectangle-Mark mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Cua-Rectangle-Mark mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cua-rect" '("cua-")))
+(register-definition-prefixes "cua-rect" '("cua-"))
;;;***
@@ -6078,10 +6196,16 @@ By convention, this is a list of symbols where each symbol stands for the
(autoload 'cursor-intangible-mode "cursor-sensor" "\
Keep cursor outside of any `cursor-intangible' text property.
-If called interactively, enable Cursor-Intangible mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Cursor-Intangible mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
@@ -6093,21 +6217,27 @@ where WINDOW is the affected window, OLDPOS is the last known position of
the cursor and DIR can be `entered' or `left' depending on whether the cursor
is entering the area covered by the text-property property or leaving it.
-If called interactively, enable Cursor-Sensor mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Cursor-Sensor mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cursor-sensor" '("cursor-sensor-")))
+(register-definition-prefixes "cursor-sensor" '("cursor-sensor-"))
;;;***
;;;### (autoloads nil "cus-dep" "cus-dep.el" (0 0 0 0))
;;; Generated autoloads from cus-dep.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cus-dep" '("custom-" "generated-custom-dependencies-file")))
+(register-definition-prefixes "cus-dep" '("custom-" "generated-custom-dependencies-file"))
;;;***
@@ -6416,7 +6546,7 @@ The format is suitable for use with `easy-menu-define'.
\(fn SYMBOL &optional NAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cus-edit" '("Custom-" "custom" "widget-")))
+(register-definition-prefixes "cus-edit" '("Custom-" "cus" "widget-"))
;;;***
@@ -6451,7 +6581,7 @@ omitted, a buffer named *Custom Themes* is used.
\(fn &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cus-theme" '("custom-" "describe-theme-1")))
+(register-definition-prefixes "cus-theme" '("custom-" "describe-theme-1"))
;;;***
@@ -6463,21 +6593,26 @@ Mode used for cvs status output.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cvs-status" '("cvs-")))
+(register-definition-prefixes "cvs-status" '("cvs-"))
;;;***
;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (0 0 0 0))
;;; Generated autoloads from progmodes/cwarn.el
-(push (purecopy '(cwarn 1 3 1)) package--builtin-versions)
(autoload 'cwarn-mode "cwarn" "\
Minor mode that highlights suspicious C and C++ constructions.
-If called interactively, enable Cwarn mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Cwarn mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Suspicious constructs are highlighted using `font-lock-warning-face'.
@@ -6509,11 +6644,13 @@ ARG is omitted or nil.
Cwarn mode is enabled in all buffers where
`turn-on-cwarn-mode-if-enabled' would do it.
-See `cwarn-mode' for more information on Cwarn mode.
+
+See `cwarn-mode' for more information on
+Cwarn mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cwarn" '("cwarn-" "turn-on-cwarn-mode-if-enabled")))
+(register-definition-prefixes "cwarn" '("cwarn-" "turn-on-cwarn-mode-if-enabled"))
;;;***
@@ -6532,7 +6669,7 @@ Return ALTERNATIVNYJ external character code of CHAR if appropriate.
\(fn CHAR)" nil nil)
(autoload 'standard-display-cyrillic-translit "cyril-util" "\
-Display a cyrillic buffer using a transliteration.
+Display a Cyrillic buffer using a transliteration.
For readability, the table is slightly
different from the one used for the input method `cyrillic-translit'.
@@ -6544,7 +6681,7 @@ If the argument is nil, we return the display table to its standard state.
\(fn &optional CYRILLIC-LANGUAGE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cyril-util" '("cyrillic-language-alist")))
+(register-definition-prefixes "cyril-util" '("cyrillic-language-alist"))
;;;***
@@ -6595,7 +6732,7 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion].
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dabbrev" '("dabbrev-")))
+(register-definition-prefixes "dabbrev" '("dabbrev-"))
;;;***
@@ -6607,7 +6744,7 @@ Create a new data-debug buffer with NAME.
\(fn NAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "data-debug" '("data-debug-" "dd-propertize")))
+(register-definition-prefixes "data-debug" '("data-debug-"))
;;;***
@@ -6617,12 +6754,12 @@ Create a new data-debug buffer with NAME.
(autoload 'dbus-handle-event "dbus" "\
Handle events from the D-Bus.
EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being
-part of the event, is called with arguments ARGS.
+part of the event, is called with arguments ARGS (without type information).
If the HANDLER returns a `dbus-error', it is propagated as return message.
\(fn EVENT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dbus" '("dbus-")))
+(register-definition-prefixes "dbus" '("dbus-"))
;;;***
@@ -6715,8 +6852,7 @@ Variables controlling indentation style and extra features:
dcl-imenu-label-call
Change the text that is used as sub-listing labels in imenu.
-Loading this package calls the value of the variable
-`dcl-mode-load-hook' with no args, if that value is non-nil.
+To run code after DCL mode has loaded, use `with-eval-after-load'.
Turning on DCL mode calls the value of the variable `dcl-mode-hook'
with no args, if that value is non-nil.
@@ -6750,7 +6886,7 @@ There is some minimal font-lock support (see vars
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dcl-mode" '("dcl-")))
+(register-definition-prefixes "dcl-mode" '("dcl-"))
;;;***
@@ -6830,7 +6966,7 @@ To specify a nil argument interactively, exit with an empty minibuffer.
(defalias 'cancel-debug-watch #'cancel-debug-on-variable-change)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "debug" '("debug" "inhibit-debug-on-entry")))
+(register-definition-prefixes "debug" '("debug" "inhibit-debug-on-entry"))
;;;***
@@ -6856,13 +6992,12 @@ The most useful commands are:
\\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint)
\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "decipher" '("decipher-")))
+(register-definition-prefixes "decipher" '("decipher-"))
;;;***
;;;### (autoloads nil "delim-col" "delim-col.el" (0 0 0 0))
;;; Generated autoloads from delim-col.el
-(push (purecopy '(delim-col 2 1)) package--builtin-versions)
(autoload 'delimit-columns-customize "delim-col" "\
Customize the `columns' group." t nil)
@@ -6901,7 +7036,7 @@ START and END delimit the corners of the text rectangle.
\(fn START END)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "delim-col" '("delimit-columns-")))
+(register-definition-prefixes "delim-col" '("delimit-columns-"))
;;;***
@@ -6923,10 +7058,16 @@ or call the function `delete-selection-mode'.")
(autoload 'delete-selection-mode "delsel" "\
Toggle Delete Selection mode.
-If called interactively, enable Delete-Selection mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Delete-Selection mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Delete Selection mode is enabled, typed text replaces the selection
if the selection is active. Otherwise, typed text is just inserted at
@@ -6937,7 +7078,7 @@ information on adapting behavior of commands in Delete Selection mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "delsel" '("del" "minibuffer-keyboard-quit")))
+(register-definition-prefixes "delsel" '("del" "minibuffer-keyboard-quit"))
;;;***
@@ -7012,7 +7153,7 @@ the first time the mode is used.
\(fn MODE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "derived" '("derived-mode-")))
+(register-definition-prefixes "derived" '("derived-mode-"))
;;;***
@@ -7067,10 +7208,12 @@ Otherwise return a description formatted by
of `eldoc-echo-area-use-multiline-p' variable and width of
minibuffer window for width limit.
-This function is meant to be used as a value of
-`eldoc-documentation-function' variable." nil nil)
+This function can be used as a value of
+`eldoc-documentation-functions' variable.
+
+\(fn CALLBACK &rest _)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "descr-text" '("describe-")))
+(register-definition-prefixes "descr-text" '("describe-"))
;;;***
@@ -7090,10 +7233,16 @@ or call the function `desktop-save-mode'.")
(autoload 'desktop-save-mode "desktop" "\
Toggle desktop saving (Desktop Save mode).
-If called interactively, enable Desktop-Save mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Desktop-Save mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Desktop Save mode is enabled, the state of Emacs is saved from
one session to another. In particular, Emacs will save the desktop when
@@ -7296,7 +7445,7 @@ Save the desktop in directory `desktop-dirname'." t nil)
(autoload 'desktop-revert "desktop" "\
Revert to the last loaded desktop." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "desktop" '("desktop-")))
+(register-definition-prefixes "desktop" '("desktop-"))
;;;***
@@ -7329,14 +7478,14 @@ article buffer.
(autoload 'gnus-article-outlook-deuglify-article "deuglify" "\
Deuglify broken Outlook (Express) articles and redisplay." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "deuglify" '("gnus-")))
+(register-definition-prefixes "deuglify" '("gnus-"))
;;;***
;;;### (autoloads nil "dframe" "dframe.el" (0 0 0 0))
;;; Generated autoloads from dframe.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dframe" '("dframe-")))
+(register-definition-prefixes "dframe" '("dframe-"))
;;;***
@@ -7381,7 +7530,7 @@ Major mode for editing the diary file.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "diary-lib" '("calendar-mark-" "diary-")))
+(register-definition-prefixes "diary-lib" '("calendar-mark-" "diary-"))
;;;***
@@ -7456,7 +7605,7 @@ OLD and NEW may each be a buffer or a buffer name.
\(fn OLD NEW &optional SWITCHES NO-ASYNC)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "diff" '("diff-")))
+(register-definition-prefixes "diff" '("diff-"))
;;;***
@@ -7483,16 +7632,22 @@ a diff with \\[diff-reverse-direction].
(autoload 'diff-minor-mode "diff-mode" "\
Toggle Diff minor mode.
-If called interactively, enable Diff minor mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Diff minor mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\\{diff-minor-mode-map}
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "diff-mode" '("diff-")))
+(register-definition-prefixes "diff-mode" '("diff-"))
;;;***
@@ -7505,7 +7660,7 @@ Optional arguments are passed to `dig-invoke'.
\(fn DOMAIN &optional QUERY-TYPE QUERY-CLASS QUERY-OPTION DIG-OPTION SERVER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dig" '("dig-" "query-dig")))
+(register-definition-prefixes "dig" '("dig-" "query-dig"))
;;;***
@@ -7635,7 +7790,6 @@ Hooks (use \\[describe-variable] to see their documentation):
`dired-before-readin-hook'
`dired-after-readin-hook'
`dired-mode-hook'
- `dired-load-hook'
Keybindings:
\\{dired-mode-map}
@@ -7643,23 +7797,24 @@ Keybindings:
\(fn &optional DIRNAME SWITCHES)" nil nil)
(put 'dired-find-alternate-file 'disabled t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired" '("dired-")))
+(autoload 'dired-jump "dired" "\
+Jump to Dired buffer corresponding to current buffer.
+If in a file, Dired the current directory and move to file's line.
+If in Dired already, pop up a level and goto old directory's line.
+In case the proper Dired file line cannot be found, refresh the dired
+buffer and try again.
+When OTHER-WINDOW is non-nil, jump to Dired buffer in other window.
+When FILE-NAME is non-nil, jump to its line in Dired.
+Interactively with prefix argument, read FILE-NAME.
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "dired-aux" "dired-aux.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from dired-aux.el
+\(fn &optional OTHER-WINDOW FILE-NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired-aux" '("dired-" "minibuffer-default-add-dired-shell-commands")))
+(autoload 'dired-jump-other-window "dired" "\
+Like \\[dired-jump] (`dired-jump') but in other window.
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "dired-x" "dired-x.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from dired-x.el
+\(fn &optional FILE-NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired-x" '("dired-" "virtual-dired")))
+(register-definition-prefixes "dired" '("dired-"))
;;;***
@@ -7669,10 +7824,16 @@ Keybindings:
(autoload 'dirtrack-mode "dirtrack" "\
Toggle directory tracking in shell buffers (Dirtrack mode).
-If called interactively, enable Dirtrack mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Dirtrack mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
This method requires that your shell prompt contain the current
working directory at all times, and that you set the variable
@@ -7693,7 +7854,7 @@ from `default-directory'.
\(fn INPUT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dirtrack" '("dirtrack-")))
+(register-definition-prefixes "dirtrack" '("dirtrack-"))
;;;***
@@ -7709,7 +7870,7 @@ redefine OBJECT if it is a symbol.
\(fn OBJECT &optional BUFFER INDENT INTERACTIVE-P)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "disass" '("disassemble-")))
+(register-definition-prefixes "disass" '("disassemble-"))
;;;***
@@ -7828,7 +7989,7 @@ in `.emacs'.
\(fn ARG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "disp-table" '("display-table-print-array")))
+(register-definition-prefixes "disp-table" '("display-table-print-array"))
;;;***
@@ -7840,10 +8001,16 @@ in `.emacs'.
Toggle display of fill-column indicator.
This uses `display-fill-column-indicator' internally.
-If called interactively, enable Display-Fill-Column-Indicator mode if
-ARG is positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and toggle
-it if ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Display-Fill-Column-Indicator mode'.
+If the prefix argument is positive, enable the mode, and if it is zero
+or negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
To change the position of the column displayed by default
customize `display-fill-column-indicator-column'. You can change the
@@ -7874,11 +8041,32 @@ ARG is omitted or nil.
Display-Fill-Column-Indicator mode is enabled in all buffers where
`display-fill-column-indicator--turn-on' would do it.
-See `display-fill-column-indicator-mode' for more information on Display-Fill-Column-Indicator mode.
+
+See `display-fill-column-indicator-mode' for more information on
+Display-Fill-Column-Indicator mode.
+
+`global-display-fill-column-indicator-modes' is used to control which modes
+this minor mode is used in.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "display-fill-column-indicator" '("display-fill-column-indicator--turn-on")))
+(defvar global-display-fill-column-indicator-modes '((not special-mode) t) "\
+Which major modes `display-fill-column-indicator-mode' is switched on in.
+This variable can be either t (all major modes), nil (no major modes),
+or a list of modes and (not modes) to switch use this minor mode or
+not. For instance
+
+ (c-mode (not message-mode mail-mode) text-mode)
+
+means \"use this mode in all modes derived from `c-mode', don't use in
+modes derived from `message-mode' or `mail-mode', but do use in other
+modes derived from `text-mode'\". An element with value t means \"use\"
+and nil means \"don't use\". There's an implicit nil at the end of the
+list.")
+
+(custom-autoload 'global-display-fill-column-indicator-modes "display-fill-column-indicator" t)
+
+(register-definition-prefixes "display-fill-column-indicator" '("display-fill-column-indicator--turn-on"))
;;;***
@@ -7890,10 +8078,16 @@ See `display-fill-column-indicator-mode' for more information on Display-Fill-Co
Toggle display of line numbers in the buffer.
This uses `display-line-numbers' internally.
-If called interactively, enable Display-Line-Numbers mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Display-Line-Numbers mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
To change the type of line numbers displayed by default,
customize `display-line-numbers-type'. To change the type while
@@ -7921,11 +8115,13 @@ ARG is omitted or nil.
Display-Line-Numbers mode is enabled in all buffers where
`display-line-numbers--turn-on' would do it.
-See `display-line-numbers-mode' for more information on Display-Line-Numbers mode.
+
+See `display-line-numbers-mode' for more information on
+Display-Line-Numbers mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "display-line-numbers" '("display-line-numbers-")))
+(register-definition-prefixes "display-line-numbers" '("display-line-numbers-"))
;;;***
@@ -7963,14 +8159,14 @@ if some action was made, or nil if the URL is ignored.")
(custom-autoload 'dnd-protocol-alist "dnd" t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dnd" '("dnd-")))
+(register-definition-prefixes "dnd" '("dnd-"))
;;;***
;;;### (autoloads nil "dns" "net/dns.el" (0 0 0 0))
;;; Generated autoloads from net/dns.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dns" '("dns-")))
+(register-definition-prefixes "dns" '("dns-"))
;;;***
@@ -7993,7 +8189,7 @@ Turning on DNS mode runs `dns-mode-hook'.
(autoload 'dns-mode-soa-increment-serial "dns-mode" "\
Locate SOA record and increment the serial field." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dns-mode" '("dns-mode-")))
+(register-definition-prefixes "dns-mode" '("dns-mode-"))
;;;***
@@ -8025,10 +8221,16 @@ to the next best mode." nil nil)
(autoload 'doc-view-minor-mode "doc-view" "\
Toggle displaying buffer via Doc View (Doc View minor mode).
-If called interactively, enable Doc-View minor mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Doc-View minor mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
See the command `doc-view-mode' for more information on this mode.
@@ -8039,7 +8241,7 @@ See the command `doc-view-mode' for more information on this mode.
\(fn BMK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "doc-view" '("doc-view-")))
+(register-definition-prefixes "doc-view" '("doc-view-"))
;;;***
@@ -8049,35 +8251,35 @@ See the command `doc-view-mode' for more information on this mode.
(autoload 'doctor "doctor" "\
Switch to *doctor* buffer and start giving psychotherapy." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "doctor" '("doc" "make-doctor-variables")))
+(register-definition-prefixes "doctor" '("doc" "make-doctor-variables"))
;;;***
;;;### (autoloads nil "dom" "dom.el" (0 0 0 0))
;;; Generated autoloads from dom.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dom" '("dom-")))
+(register-definition-prefixes "dom" '("dom-"))
;;;***
;;;### (autoloads nil "dos-fns" "dos-fns.el" (0 0 0 0))
;;; Generated autoloads from dos-fns.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dos-fns" '("dos")))
+(register-definition-prefixes "dos-fns" '("dos"))
;;;***
;;;### (autoloads nil "dos-vars" "dos-vars.el" (0 0 0 0))
;;; Generated autoloads from dos-vars.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dos-vars" '("dos-codepage-setup-hook" "msdos-shells")))
+(register-definition-prefixes "dos-vars" '("dos-codepage-setup-hook" "msdos-shells"))
;;;***
;;;### (autoloads nil "dos-w32" "dos-w32.el" (0 0 0 0))
;;; Generated autoloads from dos-w32.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dos-w32" '("file-name-buffer-file-type-alist" "find-" "w32-")))
+(register-definition-prefixes "dos-w32" '("file-name-buffer-file-type-alist" "find-" "w32-"))
;;;***
@@ -8087,28 +8289,33 @@ Switch to *doctor* buffer and start giving psychotherapy." t nil)
(autoload 'double-mode "double" "\
Toggle special insertion on double keypresses (Double mode).
-If called interactively, enable Double mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Double mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Double mode is enabled, some keys will insert different
strings when pressed twice. See `double-map' for details.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "double" '("double-")))
+(register-definition-prefixes "double" '("double-"))
;;;***
;;;### (autoloads nil "dunnet" "play/dunnet.el" (0 0 0 0))
;;; Generated autoloads from play/dunnet.el
-(push (purecopy '(dunnet 2 2)) package--builtin-versions)
(autoload 'dunnet "dunnet" "\
Switch to *dungeon* buffer and start game." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dunnet" '("dun" "obj-special")))
+(register-definition-prefixes "dunnet" '("dun" "obj-special"))
;;;***
@@ -8116,7 +8323,7 @@ Switch to *dungeon* buffer and start game." t nil)
;;;;;; 0 0))
;;; Generated autoloads from dynamic-setting.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dynamic-setting" '("dynamic-setting-handle-config-changed-event" "font-setting-change-default-font")))
+(register-definition-prefixes "dynamic-setting" '("dynamic-setting-handle-config-changed-event" "font-setting-change-default-font"))
;;;***
@@ -8172,9 +8379,6 @@ BODY contains code to execute each time the mode is enabled or disabled.
the minor mode is global):
:group GROUP Custom group name to use in all generated `defcustom' forms.
- Defaults to MODE without the possible trailing \"-mode\".
- Don't use this default group name unless you have written a
- `defgroup' to define that group properly.
:global GLOBAL If non-nil specifies that the minor mode is not meant to be
buffer-local, so don't make the variable MODE buffer-local.
By default, the mode is buffer-local.
@@ -8212,18 +8416,21 @@ For example, you could write
(autoload 'define-globalized-minor-mode "easy-mmode" "\
Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
TURN-ON is a function that will be called with no args in every buffer
- and that should try to turn MODE on if applicable for that buffer.
-Each of KEY VALUE is a pair of CL-style keyword arguments. As
- the minor mode defined by this function is always global, any
- :global keyword is ignored. Other keywords have the same
- meaning as in `define-minor-mode', which see. In particular,
- :group specifies the custom group. The most useful keywords
- are those that are passed on to the `defcustom'. It normally
- makes no sense to pass the :lighter or :keymap keywords to
- `define-globalized-minor-mode', since these are usually passed
- to the buffer-local version of the minor mode.
+and that should try to turn MODE on if applicable for that buffer.
+
+Each of KEY VALUE is a pair of CL-style keyword arguments. :predicate
+specifies which major modes the globalized minor mode should be switched on
+in. As the minor mode defined by this function is always global, any
+:global keyword is ignored. Other keywords have the same meaning as in
+`define-minor-mode', which see. In particular, :group specifies the custom
+group. The most useful keywords are those that are passed on to the
+`defcustom'. It normally makes no sense to pass the :lighter or :keymap
+keywords to `define-globalized-minor-mode', since these are usually passed
+to the buffer-local version of the minor mode.
+
BODY contains code to execute each time the mode is enabled or disabled.
- It is executed after toggling the mode, and before running GLOBAL-MODE-hook.
+It is executed after toggling the mode, and before running
+GLOBAL-MODE-hook.
If MODE's set-up depends on the major mode in effect when it was
enabled, then disabling and reenabling MODE should make MODE work
@@ -8275,7 +8482,7 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX).
(function-put 'easy-mmode-defsyntax 'lisp-indent-function '1)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "easy-mmode" '("easy-mmode-")))
+(register-definition-prefixes "easy-mmode" '("easy-mmode-"))
;;;***
@@ -8427,56 +8634,56 @@ To implement dynamic menus, either call this from
\(fn PATH NAME ITEMS &optional BEFORE MAP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "easymenu" '("add-submenu" "easy-menu-")))
+(register-definition-prefixes "easymenu" '("add-submenu" "easy-menu-"))
;;;***
;;;### (autoloads nil "ebnf-abn" "progmodes/ebnf-abn.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-abn.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-abn" '("ebnf-abn-")))
+(register-definition-prefixes "ebnf-abn" '("ebnf-abn-"))
;;;***
;;;### (autoloads nil "ebnf-bnf" "progmodes/ebnf-bnf.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-bnf.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-bnf" '("ebnf-")))
+(register-definition-prefixes "ebnf-bnf" '("ebnf-"))
;;;***
;;;### (autoloads nil "ebnf-dtd" "progmodes/ebnf-dtd.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-dtd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-dtd" '("ebnf-dtd-")))
+(register-definition-prefixes "ebnf-dtd" '("ebnf-dtd-"))
;;;***
;;;### (autoloads nil "ebnf-ebx" "progmodes/ebnf-ebx.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-ebx.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-ebx" '("ebnf-ebx-")))
+(register-definition-prefixes "ebnf-ebx" '("ebnf-ebx-"))
;;;***
;;;### (autoloads nil "ebnf-iso" "progmodes/ebnf-iso.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-iso.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-iso" '("ebnf-")))
+(register-definition-prefixes "ebnf-iso" '("ebnf-"))
;;;***
;;;### (autoloads nil "ebnf-otz" "progmodes/ebnf-otz.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-otz.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-otz" '("ebnf-")))
+(register-definition-prefixes "ebnf-otz" '("ebnf-"))
;;;***
;;;### (autoloads nil "ebnf-yac" "progmodes/ebnf-yac.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-yac.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf-yac" '("ebnf-yac-")))
+(register-definition-prefixes "ebnf-yac" '("ebnf-yac-"))
;;;***
@@ -8731,7 +8938,7 @@ See also `ebnf-push-style'.
See `ebnf-style-database' documentation." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebnf2ps" '("ebnf-")))
+(register-definition-prefixes "ebnf2ps" '("ebnf-"))
;;;***
@@ -8853,7 +9060,7 @@ Otherwise, FILE-NAME specifies the file to save the tree in.
(autoload 'ebrowse-statistics "ebrowse" "\
Display statistics for a class tree." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebrowse" '("ebrowse-" "electric-buffer-menu-mode-hook")))
+(register-definition-prefixes "ebrowse" '("ebrowse-" "electric-buffer-menu-mode-hook"))
;;;***
@@ -8888,7 +9095,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ebuff-menu" '("Electric-buffer-menu-" "electric-buffer-")))
+(register-definition-prefixes "ebuff-menu" '("Electric-buffer-menu-" "electric-buffer-"))
;;;***
@@ -8901,7 +9108,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing.
\(fn &optional NOCONFIRM)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "echistory" '("Electric-history-" "electric-")))
+(register-definition-prefixes "echistory" '("Electric-history-" "electric-"))
;;;***
@@ -8911,7 +9118,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing.
(autoload 'ecomplete-setup "ecomplete" "\
Read the .ecompleterc file." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ecomplete" '("ecomplete-")))
+(register-definition-prefixes "ecomplete" '("ecomplete-"))
;;;***
@@ -8932,24 +9139,30 @@ or call the function `global-ede-mode'.")
(autoload 'global-ede-mode "ede" "\
Toggle global EDE (Emacs Development Environment) mode.
-If called interactively, enable Global Ede mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Global Ede mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
This global minor mode enables `ede-minor-mode' in all buffers in
an EDE controlled project.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede" '("ede" "global-ede-mode-map" "project-try-ede")))
+(register-definition-prefixes "ede" '("ede" "global-ede-mode-map" "project-try-ede"))
;;;***
;;;### (autoloads nil "ede/auto" "cedet/ede/auto.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/auto.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/auto" '("ede-")))
+(register-definition-prefixes "ede/auto" '("ede-"))
;;;***
@@ -8957,102 +9170,14 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/autoconf-edit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/autoconf-edit" '("autoconf-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/base" "cedet/ede/base.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/base.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/base" '("ede-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/config" "cedet/ede/config.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/config.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/config" '("ede-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/cpp-root"
-;;;;;; "cedet/ede/cpp-root.el" (0 0 0 0))
-;;; Generated autoloads from cedet/ede/cpp-root.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/cpp-root" '("ede-c")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/custom" "cedet/ede/custom.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/custom.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/custom" '("ede-" "eieio-ede-old-variables")))
+(register-definition-prefixes "ede/autoconf-edit" '("autoconf-"))
;;;***
;;;### (autoloads nil "ede/detect" "cedet/ede/detect.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/detect.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/detect" '("ede-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/dired" "cedet/ede/dired.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/dired.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/dired" '("ede-dired-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/emacs" "cedet/ede/emacs.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/emacs.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/emacs" '("ede-emacs-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/files" "cedet/ede/files.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/files.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/files" '("ede-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/generic"
-;;;;;; "cedet/ede/generic.el" (0 0 0 0))
-;;; Generated autoloads from cedet/ede/generic.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/generic" '("ede-generic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/linux" "cedet/ede/linux.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/linux.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/linux" '("ede-linux-" "project-linux-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/locate" "cedet/ede/locate.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/locate.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/locate" '("ede-locate-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/make" "cedet/ede/make.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/make.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/make" '("ede-make-")))
+(register-definition-prefixes "ede/detect" '("ede-"))
;;;***
@@ -9060,28 +9185,28 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/makefile-edit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/makefile-edit" '("makefile-")))
+(register-definition-prefixes "ede/makefile-edit" '("makefile-"))
;;;***
;;;### (autoloads nil "ede/pconf" "cedet/ede/pconf.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/pconf.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/pconf" '("ede-pconf-create-file-query")))
+(register-definition-prefixes "ede/pconf" '("ede-pconf-create-file-query"))
;;;***
;;;### (autoloads nil "ede/pmake" "cedet/ede/pmake.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/pmake.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/pmake" '("ede-pmake-")))
+(register-definition-prefixes "ede/pmake" '("ede-pmake-"))
;;;***
;;;### (autoloads nil "ede/proj" "cedet/ede/proj.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/proj.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj" '("ede-proj-")))
+(register-definition-prefixes "ede/proj" '("ede-proj-"))
;;;***
@@ -9089,7 +9214,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/proj-archive.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-archive" '("ede-")))
+(register-definition-prefixes "ede/proj-archive" '("ede-"))
;;;***
@@ -9097,7 +9222,7 @@ an EDE controlled project.
;;;;;; 0 0))
;;; Generated autoloads from cedet/ede/proj-aux.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-aux" '("ede-")))
+(register-definition-prefixes "ede/proj-aux" '("ede-"))
;;;***
@@ -9105,7 +9230,7 @@ an EDE controlled project.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/ede/proj-comp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-comp" '("ede-" "proj-comp-insert-variable-once")))
+(register-definition-prefixes "ede/proj-comp" '("ede-" "proj-comp-insert-variable-once"))
;;;***
@@ -9113,7 +9238,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/proj-elisp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-elisp" '("ede-")))
+(register-definition-prefixes "ede/proj-elisp" '("ede-"))
;;;***
@@ -9121,7 +9246,7 @@ an EDE controlled project.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/ede/proj-info.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-info" '("ede-")))
+(register-definition-prefixes "ede/proj-info" '("ede-"))
;;;***
@@ -9129,7 +9254,7 @@ an EDE controlled project.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/ede/proj-misc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-misc" '("ede-")))
+(register-definition-prefixes "ede/proj-misc" '("ede-"))
;;;***
@@ -9137,7 +9262,7 @@ an EDE controlled project.
;;;;;; 0 0))
;;; Generated autoloads from cedet/ede/proj-obj.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-obj" '("ede-")))
+(register-definition-prefixes "ede/proj-obj" '("ede-"))
;;;***
@@ -9145,7 +9270,7 @@ an EDE controlled project.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/ede/proj-prog.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-prog" '("ede-proj-target-makefile-program")))
+(register-definition-prefixes "ede/proj-prog" '("ede-proj-target-makefile-program"))
;;;***
@@ -9153,7 +9278,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/proj-scheme.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-scheme" '("ede-proj-target-scheme")))
+(register-definition-prefixes "ede/proj-scheme" '("ede-proj-target-scheme"))
;;;***
@@ -9161,7 +9286,7 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/proj-shared.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/proj-shared" '("ede-")))
+(register-definition-prefixes "ede/proj-shared" '("ede-"))
;;;***
@@ -9169,37 +9294,21 @@ an EDE controlled project.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/ede/project-am.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/project-am" '("project-am-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/shell" "cedet/ede/shell.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/shell.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/shell" '("ede-shell-run-command")))
+(register-definition-prefixes "ede/project-am" '("project-am-"))
;;;***
;;;### (autoloads nil "ede/simple" "cedet/ede/simple.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/simple.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/simple" '("ede-simple-")))
+(register-definition-prefixes "ede/simple" '("ede-simple-"))
;;;***
;;;### (autoloads nil "ede/source" "cedet/ede/source.el" (0 0 0 0))
;;; Generated autoloads from cedet/ede/source.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/source" '("ede-source")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/speedbar"
-;;;;;; "cedet/ede/speedbar.el" (0 0 0 0))
-;;; Generated autoloads from cedet/ede/speedbar.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/speedbar" '("ede-")))
+(register-definition-prefixes "ede/source" '("ede-source"))
;;;***
@@ -9207,15 +9316,7 @@ an EDE controlled project.
;;;;;; 0))
;;; Generated autoloads from cedet/ede/srecode.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/srecode" '("ede-srecode-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ede/util" "cedet/ede/util.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/ede/util.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/util" '("ede-make-buffer-writable")))
+(register-definition-prefixes "ede/srecode" '("ede-srecode-"))
;;;***
@@ -9275,7 +9376,7 @@ Toggle edebugging of all definitions." t nil)
(autoload 'edebug-all-forms "edebug" "\
Toggle edebugging of all forms." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edebug" '("cancel-edebug-on-entry" "edebug" "get-edebug-spec" "global-edebug-")))
+(register-definition-prefixes "edebug" '("cancel-edebug-on-entry" "edebug" "get-edebug-spec" "global-edebug-"))
;;;***
@@ -9598,14 +9699,14 @@ Call `ediff-merge-directories' with the next three command line arguments." nil
(autoload 'ediff-merge-directories-with-ancestor-command "ediff" "\
Call `ediff-merge-directories-with-ancestor' with the next four command line arguments." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff" '("ediff-")))
+(register-definition-prefixes "ediff" '("ediff-"))
;;;***
;;;### (autoloads nil "ediff-diff" "vc/ediff-diff.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-diff.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-diff" '("ediff-")))
+(register-definition-prefixes "ediff-diff" '("ediff-"))
;;;***
@@ -9614,21 +9715,21 @@ Call `ediff-merge-directories-with-ancestor' with the next four command line arg
(autoload 'ediff-customize "ediff-help" nil t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-help" '("ediff-")))
+(register-definition-prefixes "ediff-help" '("ediff-"))
;;;***
;;;### (autoloads nil "ediff-init" "vc/ediff-init.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-init.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-init" '("ediff-" "stipple-pixmap")))
+(register-definition-prefixes "ediff-init" '("ediff-" "stipple-pixmap"))
;;;***
;;;### (autoloads nil "ediff-merg" "vc/ediff-merg.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-merg.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-merg" '("ediff-")))
+(register-definition-prefixes "ediff-merg" '("ediff-"))
;;;***
@@ -9640,14 +9741,14 @@ Display Ediff's registry." t nil)
(defalias 'eregistry 'ediff-show-registry)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-mult" '("ediff-")))
+(register-definition-prefixes "ediff-mult" '("ediff-"))
;;;***
;;;### (autoloads nil "ediff-ptch" "vc/ediff-ptch.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-ptch.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-ptch" '("ediff-")))
+(register-definition-prefixes "ediff-ptch" '("ediff-"))
;;;***
@@ -9664,27 +9765,26 @@ Enable or disable Ediff toolbar.
Works only in versions of Emacs that support toolbars.
To change the default, set the variable `ediff-use-toolbar-p', which see." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-util" '("ediff-")))
+(register-definition-prefixes "ediff-util" '("ediff-"))
;;;***
;;;### (autoloads nil "ediff-vers" "vc/ediff-vers.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-vers.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-vers" '("ediff-" "rcs-ediff-view-revision")))
+(register-definition-prefixes "ediff-vers" '("ediff-" "rcs-ediff-view-revision"))
;;;***
;;;### (autoloads nil "ediff-wind" "vc/ediff-wind.el" (0 0 0 0))
;;; Generated autoloads from vc/ediff-wind.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ediff-wind" '("ediff-")))
+(register-definition-prefixes "ediff-wind" '("ediff-"))
;;;***
;;;### (autoloads nil "edmacro" "edmacro.el" (0 0 0 0))
;;; Generated autoloads from edmacro.el
-(push (purecopy '(edmacro 2 1)) package--builtin-versions)
(autoload 'edit-kbd-macro "edmacro" "\
Edit a keyboard macro.
@@ -9730,7 +9830,7 @@ or nil, use a compact 80-column format.
\(fn &optional MACRO VERBOSE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edmacro" '("edmacro-")))
+(register-definition-prefixes "edmacro" '("edmacro-"))
;;;***
@@ -9747,7 +9847,7 @@ Argument BOTTOM is the bottom margin in number of lines or percent of window.
(autoload 'edt-emulation-on "edt" "\
Turn on EDT Emulation." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt" '("edt-")))
+(register-definition-prefixes "edt" '("edt-"))
;;;***
@@ -9755,7 +9855,7 @@ Turn on EDT Emulation." t nil)
;;;;;; 0))
;;; Generated autoloads from emulation/edt-lk201.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-lk201" '("*EDT-keys*")))
+(register-definition-prefixes "edt-lk201" '("*EDT-keys*"))
;;;***
@@ -9763,14 +9863,14 @@ Turn on EDT Emulation." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/edt-mapper.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-mapper" '("edt-")))
+(register-definition-prefixes "edt-mapper" '("edt-"))
;;;***
;;;### (autoloads nil "edt-pc" "emulation/edt-pc.el" (0 0 0 0))
;;; Generated autoloads from emulation/edt-pc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-pc" '("*EDT-keys*")))
+(register-definition-prefixes "edt-pc" '("*EDT-keys*"))
;;;***
@@ -9778,7 +9878,7 @@ Turn on EDT Emulation." t nil)
;;;;;; 0))
;;; Generated autoloads from emulation/edt-vt100.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "edt-vt100" '("edt-set-term-width-")))
+(register-definition-prefixes "edt-vt100" '("edt-set-term-width-"))
;;;***
@@ -9816,7 +9916,7 @@ BUFFER is put back into its original major mode.
\(fn FUN &optional NAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ehelp" '("ehelp-" "electric-")))
+(register-definition-prefixes "ehelp" '("ehelp-" "electric-"))
;;;***
@@ -9824,7 +9924,7 @@ BUFFER is put back into its original major mode.
;;; Generated autoloads from emacs-lisp/eieio.el
(push (purecopy '(eieio 1 4)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio" '("child-of-class-p" "defclass" "eieio-" "find-class" "obj" "oref" "oset" "same-class-p" "set-slot-value" "slot-" "with-slots")))
+(register-definition-prefixes "eieio" '("child-of-class-p" "defclass" "eieio-" "find-class" "obj" "oref" "oset" "same-class-p" "set-slot-value" "slot-" "with-slots"))
;;;***
@@ -9832,15 +9932,7 @@ BUFFER is put back into its original major mode.
;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/eieio-base.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-base" '("eieio-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "eieio-compat"
-;;;;;; "emacs-lisp/eieio-compat.el" (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/eieio-compat.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-compat" '("eieio--generic-static-symbol-specializers" "generic-p" "next-method-p" "no-")))
+(register-definition-prefixes "eieio-base" '("eieio-"))
;;;***
@@ -9859,15 +9951,7 @@ It creates an autoload function for CNAME's constructor.
\(fn CNAME SUPERCLASSES FILENAME DOC)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-core" '("class-" "eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "eieio-custom"
-;;;;;; "emacs-lisp/eieio-custom.el" (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/eieio-custom.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-custom" '("eieio-")))
+(register-definition-prefixes "eieio-core" '("class-" "eieio-" "inconsistent-class-hierarchy" "invalid-slot-" "unbound-slot"))
;;;***
@@ -9875,23 +9959,21 @@ It creates an autoload function for CNAME's constructor.
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/eieio-datadebug.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-datadebug" '("data-debug-insert-object-")))
+(register-definition-prefixes "eieio-datadebug" '("data-debug-insert-object-"))
;;;***
-;;;### (autoloads "actual autoloads are elsewhere" "eieio-opt" "emacs-lisp/eieio-opt.el"
+;;;### (autoloads nil "eieio-speedbar" "emacs-lisp/eieio-speedbar.el"
;;;;;; (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/eieio-opt.el
+;;; Generated autoloads from emacs-lisp/eieio-speedbar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-opt" '("eieio-")))
+(register-definition-prefixes "eieio-speedbar" '("eieio-speedbar"))
;;;***
-;;;### (autoloads nil "eieio-speedbar" "emacs-lisp/eieio-speedbar.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/eieio-speedbar.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eieio-speedbar" '("eieio-speedbar")))
+;;;### (autoloads nil "eldoc" "emacs-lisp/eldoc.el" (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/eldoc.el
+(push (purecopy '(eldoc 1 11 0)) package--builtin-versions)
;;;***
@@ -9911,10 +9993,16 @@ or call the function `electric-pair-mode'.")
(autoload 'electric-pair-mode "elec-pair" "\
Toggle automatic parens pairing (Electric Pair mode).
-If called interactively, enable Electric-Pair mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Electric-Pair mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Electric Pair mode is a global minor mode. When enabled, typing
an open parenthesis automatically inserts the corresponding
@@ -9929,14 +10017,20 @@ To toggle the mode in a single buffer, use `electric-pair-local-mode'.
(autoload 'electric-pair-local-mode "elec-pair" "\
Toggle `electric-pair-mode' only in this buffer.
-If called interactively, enable Electric-Pair-Local mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Electric-Pair-Local mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elec-pair" '("electric-pair-")))
+(register-definition-prefixes "elec-pair" '("electric-pair-"))
;;;***
@@ -9953,7 +10047,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elide-head" '("elide-head-")))
+(register-definition-prefixes "elide-head" '("elide-head-"))
;;;***
@@ -9986,7 +10080,7 @@ optional prefix argument REINIT is non-nil.
\(fn &optional REINIT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elint" '("elint-")))
+(register-definition-prefixes "elint" '("elint-"))
;;;***
@@ -10021,143 +10115,7 @@ If `elp-reset-after-results' is non-nil, then current profiling
information for all instrumented functions is reset after results are
displayed." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elp" '("elp-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-alias" "eshell/em-alias.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-alias.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-alias" '("eshell" "pcomplete/eshell-mode/alias")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-banner" "eshell/em-banner.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-banner.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-banner" '("eshell-banner-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-basic" "eshell/em-basic.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-basic.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-basic" '("eshell")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-cmpl" "eshell/em-cmpl.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-cmpl.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-cmpl" '("eshell-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-dirs" "eshell/em-dirs.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-dirs.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-dirs" '("eshell")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-glob" "eshell/em-glob.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-glob.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-glob" '("eshell-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-hist" "eshell/em-hist.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-hist.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-hist" '("eshell")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-ls" "eshell/em-ls.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-ls.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-ls" '("eshell")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-pred" "eshell/em-pred.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-pred.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-pred" '("eshell-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-prompt" "eshell/em-prompt.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-prompt.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-prompt" '("eshell-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-rebind" "eshell/em-rebind.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-rebind.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-rebind" '("eshell-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-script" "eshell/em-script.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-script.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-script" '("eshell")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-smart" "eshell/em-smart.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-smart.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-smart" '("eshell-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-term" "eshell/em-term.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-term.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-term" '("eshell-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-tramp" "eshell/em-tramp.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-tramp.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-tramp" '("eshell")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-unix" "eshell/em-unix.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-unix.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-unix" '("eshell" "nil-blank-string" "pcomplete/")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "em-xtra" "eshell/em-xtra.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from eshell/em-xtra.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "em-xtra" '("eshell/" "pcomplete/bcc")))
+(register-definition-prefixes "elp" '("elp-"))
;;;***
@@ -10187,7 +10145,7 @@ some major modes from being locked under some circumstances.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emacs-lock" '("emacs-lock-" "toggle-emacs-lock")))
+(register-definition-prefixes "emacs-lock" '("emacs-lock-" "toggle-emacs-lock"))
;;;***
@@ -10198,11 +10156,23 @@ some major modes from being locked under some circumstances.
Report a bug in GNU Emacs.
Prompts for bug subject. Leaves you in a mail buffer.
+Already submitted bugs can be found in the Emacs bug tracker:
+
+ https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1
+
\(fn TOPIC &optional UNUSED)" t nil)
(set-advertised-calling-convention 'report-emacs-bug '(topic) '"24.5")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emacsbug" '("report-emacs-bug-")))
+(autoload 'submit-emacs-patch "emacsbug" "\
+Send an Emacs patch to the Emacs maintainers.
+Interactively, you will be prompted for SUBJECT and a patch FILE
+name (which will be attached to the mail). You will end up in a
+Message buffer where you can explain more about the patch.
+
+\(fn SUBJECT FILE)" t nil)
+
+(register-definition-prefixes "emacsbug" '("emacs-bug--system-description" "report-emacs-bug-"))
;;;***
@@ -10258,7 +10228,7 @@ Emerge two RCS revisions of a file, with another revision as ancestor.
\(fn A-DIR B-DIR ANCESTOR-DIR OUTPUT-DIR)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "emerge" '("emerge-")))
+(register-definition-prefixes "emerge" '("emerge-"))
;;;***
@@ -10270,10 +10240,16 @@ Minor mode for editing text/enriched files.
These are files with embedded formatting information in the MIME standard
text/enriched format.
-If called interactively, enable Enriched mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Enriched mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Turning the mode on or off runs `enriched-mode-hook'.
@@ -10296,7 +10272,7 @@ Commands:
\(fn FROM TO)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "enriched" '("enriched-")))
+(register-definition-prefixes "enriched" '("enriched-"))
;;;***
@@ -10486,7 +10462,7 @@ Insert selected KEYS after the point.
\(fn KEYS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epa" '("epa-")))
+(register-definition-prefixes "epa" '("epa-"))
;;;***
@@ -10519,7 +10495,7 @@ Encrypt marked files." t nil)
(autoload 'epa-file-disable "epa-file" nil t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epa-file" '("epa-")))
+(register-definition-prefixes "epa-file" '("epa-"))
;;;***
@@ -10529,10 +10505,16 @@ Encrypt marked files." t nil)
(autoload 'epa-mail-mode "epa-mail" "\
A minor-mode for composing encrypted/clearsigned mails.
-If called interactively, enable epa-mail mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `epa-mail mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
@@ -10593,14 +10575,20 @@ or call the function `epa-global-mail-mode'.")
(autoload 'epa-global-mail-mode "epa-mail" "\
Minor mode to hook EasyPG into Mail mode.
-If called interactively, enable Epa-Global-Mail mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Epa-Global-Mail mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epa-mail" '("epa-mail-")))
+(register-definition-prefixes "epa-mail" '("epa-mail-"))
;;;***
@@ -10613,7 +10601,7 @@ Return a context object.
\(fn &optional PROTOCOL ARMOR TEXTMODE INCLUDE-CERTS CIPHER-ALGORITHM DIGEST-ALGORITHM COMPRESS-ALGORITHM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epg" '("epg-")))
+(register-definition-prefixes "epg" '("epg-"))
;;;***
@@ -10653,7 +10641,7 @@ Look at CONFIG and try to expand GROUP.
\(fn CONFIG GROUP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epg-config" '("epg-")))
+(register-definition-prefixes "epg-config" '("epg-"))
;;;***
@@ -10679,7 +10667,7 @@ Non-interactively, it takes the keyword arguments
That is, if called with
- (erc :server \"irc.freenode.net\" :full-name \"Harry S Truman\")
+ (erc :server \"chat.freenode.net\" :full-name \"Harry S Truman\")
then the server and full-name will be set to those values, whereas
`erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will
@@ -10702,163 +10690,35 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
\(fn HOST PORT CHANNEL USER PASSWORD)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc" '("define-erc-module" "erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-autoaway"
-;;;;;; "erc/erc-autoaway.el" (0 0 0 0))
-;;; Generated autoloads from erc/erc-autoaway.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-autoaway" '("erc-auto")))
+(register-definition-prefixes "erc" '("define-erc-module" "erc-"))
;;;***
;;;### (autoloads nil "erc-backend" "erc/erc-backend.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-backend.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-backend" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-button" "erc/erc-button.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-button.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-button" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-capab" "erc/erc-capab.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-capab.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-capab" '("erc-capab-identify-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-compat" "erc/erc-compat.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-compat.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-compat" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-dcc" "erc/erc-dcc.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-dcc.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-dcc" '("erc-" "pcomplete/erc-mode/")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-desktop-notifications"
-;;;;;; "erc/erc-desktop-notifications.el" (0 0 0 0))
-;;; Generated autoloads from erc/erc-desktop-notifications.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-desktop-notifications" '("erc-notifications-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-ezbounce"
-;;;;;; "erc/erc-ezbounce.el" (0 0 0 0))
-;;; Generated autoloads from erc/erc-ezbounce.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ezbounce" '("erc-ezb-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-fill" "erc/erc-fill.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-fill.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-fill" '("erc-")))
+(register-definition-prefixes "erc-backend" '("erc-"))
;;;***
;;;### (autoloads nil "erc-goodies" "erc/erc-goodies.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-goodies.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-goodies" '("erc-")))
+(register-definition-prefixes "erc-goodies" '("erc-"))
;;;***
;;;### (autoloads nil "erc-ibuffer" "erc/erc-ibuffer.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-ibuffer.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ibuffer" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-identd" "erc/erc-identd.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-identd.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-identd" '("erc-identd-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-imenu" "erc/erc-imenu.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-imenu.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-imenu" '("erc-unfill-notice")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-join" "erc/erc-join.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-join.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-join" '("erc-")))
+(register-definition-prefixes "erc-ibuffer" '("erc-"))
;;;***
;;;### (autoloads nil "erc-lang" "erc/erc-lang.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-lang.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-lang" '("erc-cmd-LANG" "iso-638-languages" "language")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-list" "erc/erc-list.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-list.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-list" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-log" "erc/erc-log.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-log.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-log" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-match" "erc/erc-match.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-match.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-match" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-menu" "erc/erc-menu.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-menu.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-menu" '("erc-menu-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-netsplit"
-;;;;;; "erc/erc-netsplit.el" (0 0 0 0))
-;;; Generated autoloads from erc/erc-netsplit.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-netsplit" '("erc-")))
+(register-definition-prefixes "erc-lang" '("erc-cmd-LANG" "iso-638-languages" "language"))
;;;***
@@ -10874,111 +10734,7 @@ server name and search for a match in `erc-networks-alist'." nil nil)
(autoload 'erc-server-select "erc-networks" "\
Interactively select a server to connect to using `erc-server-alist'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-networks" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-notify" "erc/erc-notify.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-notify.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-notify" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-page" "erc/erc-page.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-page.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-page" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-pcomplete"
-;;;;;; "erc/erc-pcomplete.el" (0 0 0 0))
-;;; Generated autoloads from erc/erc-pcomplete.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-pcomplete" '("erc-pcomplet" "pcomplete")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-replace"
-;;;;;; "erc/erc-replace.el" (0 0 0 0))
-;;; Generated autoloads from erc/erc-replace.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-replace" '("erc-replace-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-ring" "erc/erc-ring.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-ring.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ring" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-services"
-;;;;;; "erc/erc-services.el" (0 0 0 0))
-;;; Generated autoloads from erc/erc-services.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-services" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-sound" "erc/erc-sound.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-sound.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-sound" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-speedbar"
-;;;;;; "erc/erc-speedbar.el" (0 0 0 0))
-;;; Generated autoloads from erc/erc-speedbar.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-speedbar" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-spelling"
-;;;;;; "erc/erc-spelling.el" (0 0 0 0))
-;;; Generated autoloads from erc/erc-spelling.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-spelling" '("erc-spelling-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-stamp" "erc/erc-stamp.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-stamp.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-stamp" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-track" "erc/erc-track.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-track.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-track" '("erc-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-truncate"
-;;;;;; "erc/erc-truncate.el" (0 0 0 0))
-;;; Generated autoloads from erc/erc-truncate.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-truncate" '("erc-max-buffer-size")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "erc-xdcc" "erc/erc-xdcc.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from erc/erc-xdcc.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-xdcc" '("erc-")))
+(register-definition-prefixes "erc-networks" '("erc-"))
;;;***
@@ -11053,7 +10809,7 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test).
\(fn TEST-OR-TEST-NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ert" '("ert-")))
+(register-definition-prefixes "ert" '("ert-"))
;;;***
@@ -11065,35 +10821,35 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test).
(autoload 'ert-kill-all-test-buffers "ert-x" "\
Kill all test buffers that are still live." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ert-x" '("ert-")))
+(register-definition-prefixes "ert-x" '("ert-"))
;;;***
;;;### (autoloads nil "esh-arg" "eshell/esh-arg.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-arg.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-arg" '("eshell-")))
+(register-definition-prefixes "esh-arg" '("eshell-"))
;;;***
;;;### (autoloads nil "esh-cmd" "eshell/esh-cmd.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-cmd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-cmd" '("eshell" "pcomplete/eshell-mode/eshell-debug")))
+(register-definition-prefixes "esh-cmd" '("eshell" "pcomplete/eshell-mode/eshell-debug"))
;;;***
;;;### (autoloads nil "esh-ext" "eshell/esh-ext.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-ext.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-ext" '("eshell")))
+(register-definition-prefixes "esh-ext" '("eshell"))
;;;***
;;;### (autoloads nil "esh-io" "eshell/esh-io.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-io.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-io" '("eshell-")))
+(register-definition-prefixes "esh-io" '("eshell-"))
;;;***
@@ -11105,7 +10861,12 @@ Emacs shell interactive mode.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-mode" '("eshell")))
+(autoload 'eshell-bookmark-jump "esh-mode" "\
+Default bookmark handler for Eshell buffers.
+
+\(fn BOOKMARK)" nil nil)
+
+(register-definition-prefixes "esh-mode" '("eshell"))
;;;***
@@ -11113,35 +10874,35 @@ Emacs shell interactive mode.
;;;;;; 0))
;;; Generated autoloads from eshell/esh-module.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-module" '("eshell-")))
+(register-definition-prefixes "esh-module" '("eshell-"))
;;;***
;;;### (autoloads nil "esh-opt" "eshell/esh-opt.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-opt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-opt" '("eshell-")))
+(register-definition-prefixes "esh-opt" '("eshell-"))
;;;***
;;;### (autoloads nil "esh-proc" "eshell/esh-proc.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-proc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-proc" '("eshell")))
+(register-definition-prefixes "esh-proc" '("eshell"))
;;;***
;;;### (autoloads nil "esh-util" "eshell/esh-util.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-util" '("eshell-")))
+(register-definition-prefixes "esh-util" '("eshell-"))
;;;***
;;;### (autoloads nil "esh-var" "eshell/esh-var.el" (0 0 0 0))
;;; Generated autoloads from eshell/esh-var.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "esh-var" '("eshell" "pcomplete/eshell-mode/")))
+(register-definition-prefixes "esh-var" '("eshell" "pcomplete/eshell-mode/"))
;;;***
@@ -11183,9 +10944,7 @@ corresponding to a successful execution.
\(fn COMMAND &optional STATUS-VAR)" nil nil)
-(define-obsolete-function-alias 'eshell-report-bug 'report-emacs-bug "23.1")
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eshell" '("eshell-")))
+(register-definition-prefixes "eshell" '("eshell-"))
;;;***
@@ -11453,7 +11212,7 @@ Do `query-replace-regexp' of FROM with TO on all files listed in tags table.
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
with the command \\[tags-loop-continue].
-For non-interactive use, superceded by `fileloop-initialize-replace'.
+For non-interactive use, superseded by `fileloop-initialize-replace'.
\(fn FROM TO &optional DELIMITED FILES)" t nil)
@@ -11489,7 +11248,7 @@ for \\[find-tag] (which see)." t nil)
(autoload 'etags--xref-backend "etags" nil nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function" "xref-")))
+(register-definition-prefixes "etags" '("default-tags-table-function" "etags-" "file-of-tag" "find-tag-" "goto-tag-location-function" "initialize-new-tags-table" "last-tag" "list-tags-function" "select-tags-table-" "snarf-tag-function" "tag" "verify-tags-table-function" "xref-"))
;;;***
@@ -11643,7 +11402,7 @@ With ARG, insert that many delimiters.
\(fn POS TO FONT-OBJECT STRING DIRECTION)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ethio-util" '("ethio-" "exit-ethiopic-environment")))
+(register-definition-prefixes "ethio-util" '("ethio-" "exit-ethiopic-environment"))
;;;***
@@ -11710,7 +11469,7 @@ This does nothing except loading eudc by autoload side-effect." t nil)
(fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc" '("eudc-")))
+(register-definition-prefixes "eudc" '("eudc-"))
;;;***
@@ -11747,7 +11506,7 @@ Display a button for the JPEG DATA.
\(fn DATA)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-bob" '("eudc-")))
+(register-definition-prefixes "eudc-bob" '("eudc-bob-"))
;;;***
@@ -11761,7 +11520,7 @@ This function can only be called from a directory query result buffer." t nil)
(autoload 'eudc-try-bbdb-insert "eudc-export" "\
Call `eudc-insert-record-at-point-into-bbdb' if on a record." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-export" '("eudc-")))
+(register-definition-prefixes "eudc-export" '("eudc-"))
;;;***
@@ -11772,35 +11531,43 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record." t nil)
(autoload 'eudc-edit-hotlist "eudc-hotlist" "\
Edit the hotlist of directory servers in a specialized buffer." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-hotlist" '("eudc-hotlist-")))
+(register-definition-prefixes "eudc-hotlist" '("eudc-hotlist-"))
;;;***
;;;### (autoloads nil "eudc-vars" "net/eudc-vars.el" (0 0 0 0))
;;; Generated autoloads from net/eudc-vars.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudc-vars" '("eudc-")))
+(register-definition-prefixes "eudc-vars" '("eudc-"))
;;;***
;;;### (autoloads nil "eudcb-bbdb" "net/eudcb-bbdb.el" (0 0 0 0))
;;; Generated autoloads from net/eudcb-bbdb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudcb-bbdb" '("eudc-bbdb-")))
+(register-definition-prefixes "eudcb-bbdb" '("eudc-bbdb-"))
;;;***
;;;### (autoloads nil "eudcb-ldap" "net/eudcb-ldap.el" (0 0 0 0))
;;; Generated autoloads from net/eudcb-ldap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudcb-ldap" '("eudc-")))
+(register-definition-prefixes "eudcb-ldap" '("eudc-"))
;;;***
;;;### (autoloads nil "eudcb-mab" "net/eudcb-mab.el" (0 0 0 0))
;;; Generated autoloads from net/eudcb-mab.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudcb-mab" '("eudc-")))
+(register-definition-prefixes "eudcb-mab" '("eudc-"))
+
+;;;***
+
+;;;### (autoloads nil "eudcb-macos-contacts" "net/eudcb-macos-contacts.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from net/eudcb-macos-contacts.el
+
+(register-definition-prefixes "eudcb-macos-contacts" '("eudc-macos-contacts-"))
;;;***
@@ -11828,7 +11595,7 @@ fourth arg NOSEP non-nil inhibits this.
\(fn PRETTY-PRINTER &optional HEADER FOOTER NOSEP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ewoc" '("ewoc-")))
+(register-definition-prefixes "ewoc" '("ewoc-"))
;;;***
@@ -11843,6 +11610,20 @@ duplicate entries (if any) removed.")
(custom-autoload 'eww-suggest-uris "eww" t)
+(autoload 'eww-browse "eww" "\
+Function to be run to parse command line URLs.
+This is meant to be used for MIME handlers or command line use.
+
+Setting the handler for \"text/x-uri;\" to
+\"emacs -f eww-browse %u\" will then start up Emacs and call eww
+to browse the url.
+
+This can also be used on the command line directly:
+
+ emacs -f eww-browse https://gnu.org
+
+will start Emacs and browse the GNU web site." t nil)
+
(autoload 'eww "eww" "\
Fetch URL and render the page.
If the input doesn't look like an URL or a domain name, the
@@ -11851,7 +11632,11 @@ word(s) will be searched for via `eww-search-prefix'.
If called with a prefix ARG, use a new buffer instead of reusing
the default EWW buffer.
-\(fn URL &optional ARG)" t nil)
+If BUFFER, the data to be rendered is in that buffer. In that
+case, this function doesn't actually fetch URL. BUFFER will be
+killed after rendering.
+
+\(fn URL &optional ARG BUFFER)" t nil)
(defalias 'browse-web 'eww)
(autoload 'eww-open-file "eww" "\
@@ -11891,7 +11676,7 @@ instead of `browse-url-new-window-flag'.
(autoload 'eww-list-bookmarks "eww" "\
Display the bookmarks." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eww" '("eww-")))
+(register-definition-prefixes "eww" '("erc--download-directory" "eww-"))
;;;***
@@ -11927,14 +11712,14 @@ Make file executable according to umask if not already executable.
If file already has any execute bits set at all, do not change existing
file modes." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "executable" '("executable-")))
+(register-definition-prefixes "executable" '("executable-"))
;;;***
;;;### (autoloads nil "exif" "image/exif.el" (0 0 0 0))
;;; Generated autoloads from image/exif.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "exif" '("exif-")))
+(register-definition-prefixes "exif" '("exif-"))
;;;***
@@ -11979,14 +11764,14 @@ This is used only in conjunction with `expand-add-abbrevs'." t nil)
(define-key abbrev-map "p" 'expand-jump-to-previous-slot)
(define-key abbrev-map "n" 'expand-jump-to-next-slot)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "expand" '("expand-")))
+(register-definition-prefixes "expand" '("expand-"))
;;;***
;;;### (autoloads nil "ezimage" "ezimage.el" (0 0 0 0))
;;; Generated autoloads from ezimage.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ezimage" '("defezimage" "ezimage-")))
+(register-definition-prefixes "ezimage" '("defezimage" "ezimage-"))
;;;***
@@ -12055,7 +11840,7 @@ with no args, if that value is non-nil.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "f90" '("f90-")))
+(register-definition-prefixes "f90" '("f90-"))
;;;***
@@ -12173,10 +11958,16 @@ a top-level keymap, `text-scale-increase' or
(autoload 'buffer-face-mode "face-remap" "\
Minor mode for a buffer-specific default face.
-If called interactively, enable Buffer-Face mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Buffer-Face mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When enabled, the face specified by the variable
`buffer-face-mode-face' is used to display the buffer text.
@@ -12220,7 +12011,7 @@ Besides the choice of face, it is the same as `buffer-face-mode'.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "face-remap" '("buffer-face-mode-" "face-" "internal-lisp-face-attributes" "text-scale-m")))
+(register-definition-prefixes "face-remap" '("buffer-face-mode-" "face-" "internal-lisp-face-attributes" "text-scale-m"))
;;;***
@@ -12259,7 +12050,7 @@ FUNCTION must return an explanation when the test fails and
\(fn FUNCTION)" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "faceup" '("faceup-")))
+(register-definition-prefixes "faceup" '("faceup-"))
;;;***
@@ -12313,7 +12104,7 @@ you can set `feedmail-queue-reminder-alist' to nil.
\(fn &optional WHAT-EVENT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "feedmail" '("feedmail-")))
+(register-definition-prefixes "feedmail" '("feedmail-"))
;;;***
@@ -12375,7 +12166,7 @@ This hook is intended to be put in `file-name-at-point-functions'." nil nil)
(autoload 'ffap-bindings "ffap" "\
Evaluate the forms in variable `ffap-bindings'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ffap" '("dired-at-point-" "ffap-" "find-file-literally-at-point")))
+(register-definition-prefixes "ffap" '("dired-at-point-" "ffap-" "find-file-literally-at-point"))
;;;***
@@ -12434,7 +12225,7 @@ the name is considered already unique; only the second substitution
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "filecache" '("file-cache-")))
+(register-definition-prefixes "filecache" '("file-cache-"))
;;;***
@@ -12461,20 +12252,20 @@ operating on the next file and nil otherwise.
(autoload 'fileloop-initialize-replace "fileloop" "\
Initialize a new round of query&replace on several files.
- FROM is a regexp and TO is the replacement to use.
- FILES describes the files, as in `fileloop-initialize'.
- CASE-FOLD can be t, nil, or `default':
- if it is nil, matching of FROM is case-sensitive.
- if it is t, matching of FROM is case-insensitive, except
- when `search-upper-case' is non-nil and FROM includes
- upper-case letters.
- if it is `default', the function uses the value of
- `case-fold-search' instead.
- DELIMITED if non-nil means replace only word-delimited matches.
+FROM is a regexp and TO is the replacement to use.
+FILES describes the files, as in `fileloop-initialize'.
+CASE-FOLD can be t, nil, or `default':
+ if it is nil, matching of FROM is case-sensitive.
+ if it is t, matching of FROM is case-insensitive, except
+ when `search-upper-case' is non-nil and FROM includes
+ upper-case letters.
+ if it is `default', the function uses the value of
+ `case-fold-search' instead.
+DELIMITED if non-nil means replace only word-delimited matches.
\(fn FROM TO FILES CASE-FOLD &optional DELIMITED)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fileloop" '("fileloop-")))
+(register-definition-prefixes "fileloop" '("fileloop-"))
;;;***
@@ -12488,7 +12279,7 @@ Otherwise, signal a `file-notify-error'.
\(fn OBJECT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "filenotify" '("file-notify-")))
+(register-definition-prefixes "filenotify" '("file-notify-"))
;;;***
@@ -12594,7 +12385,7 @@ Execute BODY, and unwind connection-local variables.
\(fn &rest BODY)" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "files-x" '("connection-local-" "dir-locals-to-string" "hack-connection-local-variables" "modify-" "read-file-local-variable")))
+(register-definition-prefixes "files-x" '("connection-local-" "dir-locals-to-string" "hack-connection-local-variables" "modify-" "read-file-local-variable"))
;;;***
@@ -12605,7 +12396,7 @@ Execute BODY, and unwind connection-local variables.
Filesets initialization.
Set up hooks, load the cache file -- if existing -- and build the menu." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "filesets" '("filesets-")))
+(register-definition-prefixes "filesets" '("filesets-"))
;;;***
@@ -12627,7 +12418,7 @@ result is a string that should be ready for the command line.
\(fn &rest SUBFINDS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-cmd" '("find-")))
+(register-definition-prefixes "find-cmd" '("find-"))
;;;***
@@ -12643,6 +12434,9 @@ The command run (after changing into DIR) is essentially
except that the car of the variable `find-ls-option' specifies what to
use in place of \"-ls\" as the final argument.
+Collect output in the \"*Find*\" buffer. To kill the job before
+it finishes, type \\[kill-find].
+
\(fn DIR ARGS)" t nil)
(autoload 'find-name-dired "find-dired" "\
@@ -12669,7 +12463,7 @@ specifies what to use in place of \"-ls\" as the final argument.
\(fn DIR REGEXP)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-dired" '("find-" "kill-find" "lookfor-dired")))
+(register-definition-prefixes "find-dired" '("find-" "kill-find" "lookfor-dired"))
;;;***
@@ -12761,7 +12555,7 @@ Visit the file you click on in another window.
\(fn EVENT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-file" '("cc-" "ff-" "modula2-other-file-alist")))
+(register-definition-prefixes "find-file" '("cc-" "ff-" "modula2-other-file-alist"))
;;;***
@@ -12776,6 +12570,13 @@ Interactively, prompt for LIBRARY using the one at or near point.
\(fn LIBRARY)" t nil)
+(autoload 'read-library-name "find-func" "\
+Read and return a library name, defaulting to the one near point.
+
+A library name is the filename of an Emacs Lisp library located
+in a directory under `load-path' (or `find-function-source-path',
+if non-nil)." nil nil)
+
(autoload 'find-library-other-window "find-func" "\
Find the Emacs Lisp source of LIBRARY in another window.
@@ -12943,7 +12744,7 @@ Find directly the variable at point in the other window." t nil)
(autoload 'find-function-setup-keys "find-func" "\
Define some key bindings for the find-function family of functions." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-func" '("find-" "read-library-name")))
+(register-definition-prefixes "find-func" '("find-"))
;;;***
@@ -12965,7 +12766,7 @@ Change the filter on a `find-lisp-find-dired' buffer to REGEXP.
\(fn REGEXP)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "find-lisp" '("find-lisp-")))
+(register-definition-prefixes "find-lisp" '("find-lisp-"))
;;;***
@@ -12985,7 +12786,7 @@ FILE should be in a form suitable for passing to `locate-library'.
(autoload 'finder-by-keyword "finder" "\
Find packages matching a given keyword." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "finder" '("finder-" "generated-finder-keywords-file")))
+(register-definition-prefixes "finder" '("finder-" "generated-finder-keywords-file"))
;;;***
@@ -13008,7 +12809,7 @@ to get the effect of a C-q.
\(fn &rest LOSING-TERMINAL-TYPES)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flow-ctrl" '("flow-control-c-")))
+(register-definition-prefixes "flow-ctrl" '("flow-control-c-"))
;;;***
@@ -13029,13 +12830,13 @@ lines.
\(fn &optional BUFFER DELETE-SPACE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flow-fill" '("fill-flowed-")))
+(register-definition-prefixes "flow-fill" '("fill-flowed-"))
;;;***
;;;### (autoloads nil "flymake" "progmodes/flymake.el" (0 0 0 0))
;;; Generated autoloads from progmodes/flymake.el
-(push (purecopy '(flymake 1 0 8)) package--builtin-versions)
+(push (purecopy '(flymake 1 0 9)) package--builtin-versions)
(autoload 'flymake-log "flymake" "\
Log, at level LEVEL, the message MSG formatted with ARGS.
@@ -13079,10 +12880,16 @@ region is invalid.
(autoload 'flymake-mode "flymake" "\
Toggle Flymake mode on or off.
-If called interactively, enable Flymake mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Flymake mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Flymake is an Emacs minor mode for on-the-fly syntax checking.
Flymake collects diagnostic information from multiple sources,
@@ -13122,7 +12929,7 @@ Turn Flymake mode on." nil nil)
(autoload 'flymake-mode-off "flymake" "\
Turn Flymake mode off." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake" '("flymake-")))
+(register-definition-prefixes "flymake" '("flymake-"))
;;;***
@@ -13138,7 +12945,7 @@ REPORT-FN is Flymake's callback.
\(fn REPORT-FN &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-cc" '("flymake-cc-")))
+(register-definition-prefixes "flymake-cc" '("flymake-cc-"))
;;;***
@@ -13147,7 +12954,7 @@ REPORT-FN is Flymake's callback.
;;; Generated autoloads from progmodes/flymake-proc.el
(push (purecopy '(flymake-proc 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-proc" '("flymake-proc-")))
+(register-definition-prefixes "flymake-proc" '("flymake-proc-"))
;;;***
@@ -13161,10 +12968,16 @@ Turn on `flyspell-mode' for comments and strings." t nil)
(autoload 'flyspell-mode "flyspell" "\
Toggle on-the-fly spell checking (Flyspell mode).
-If called interactively, enable Flyspell mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Flyspell mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Flyspell mode is a buffer-local minor mode. When enabled, it
spawns a single Ispell process and checks each word. The default
@@ -13186,7 +12999,7 @@ invoking `ispell-change-dictionary'.
Consider using the `ispell-parser' to check your text. For instance
consider adding:
-\(add-hook \\='tex-mode-hook (function (lambda () (setq ispell-parser \\='tex))))
+\(add-hook \\='tex-mode-hook (lambda () (setq ispell-parser \\='tex)))
in your init file.
\\[flyspell-region] checks all words inside a region.
@@ -13214,7 +13027,7 @@ of a misspelled word removed when you've corrected it.
(autoload 'flyspell-buffer "flyspell" "\
Flyspell whole buffer." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flyspell" '("flyspell-" "mail-mode-flyspell-verify" "make-flyspell-overlay" "sgml-mode-flyspell-verify" "tex")))
+(register-definition-prefixes "flyspell" '("flyspell-" "mail-mode-flyspell-verify" "make-flyspell-overlay" "sgml-mode-flyspell-verify" "tex"))
;;;***
@@ -13222,7 +13035,7 @@ Flyspell whole buffer." t nil)
;;; Generated autoloads from foldout.el
(push (purecopy '(foldout 1 10)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "foldout" '("foldout-")))
+(register-definition-prefixes "foldout" '("foldout-"))
;;;***
@@ -13238,10 +13051,16 @@ Turn off Follow mode. Please see the function `follow-mode'." nil nil)
(autoload 'follow-mode "follow" "\
Toggle Follow mode.
-If called interactively, enable Follow mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Follow mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Follow mode is a minor mode that combines windows into one tall
virtual window. This is accomplished by two main techniques:
@@ -13344,7 +13163,7 @@ selected if the original window is the first one in the frame.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "follow" '("follow-")))
+(register-definition-prefixes "follow" '("follow-"))
;;;***
@@ -13352,21 +13171,26 @@ selected if the original window is the first one in the frame.
;;;;;; 0))
;;; Generated autoloads from international/fontset.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fontset" '("charset-script-alist" "create-" "fontset-" "generate-fontset-menu" "set" "standard-fontset-spec" "x-" "xlfd-")))
+(register-definition-prefixes "fontset" '("charset-script-alist" "create-" "fontset-" "generate-fontset-menu" "set" "standard-fontset-spec" "x-" "xlfd-"))
;;;***
;;;### (autoloads nil "footnote" "mail/footnote.el" (0 0 0 0))
;;; Generated autoloads from mail/footnote.el
-(push (purecopy '(footnote 0 19)) package--builtin-versions)
(autoload 'footnote-mode "footnote" "\
Toggle Footnote mode.
-If called interactively, enable Footnote mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Footnote mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Footnote mode is a buffer-local minor mode. If enabled, it
provides footnote support for `message-mode'. To get started,
@@ -13375,14 +13199,61 @@ play around with the following keys:
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "footnote" '("footnote-")))
+(register-definition-prefixes "footnote" '("footnote-"))
;;;***
;;;### (autoloads nil "format-spec" "format-spec.el" (0 0 0 0))
;;; Generated autoloads from format-spec.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "format-spec" '("format-spec")))
+(autoload 'format-spec "format-spec" "\
+Return a string based on FORMAT and SPECIFICATION.
+FORMAT is a string containing `format'-like specs like \"su - %u %k\".
+SPECIFICATION is an alist mapping format specification characters
+to their substitutions.
+
+For instance:
+
+ (format-spec \"su - %u %l\"
+ \\=`((?u . ,(user-login-name))
+ (?l . \"ls\")))
+
+Each %-spec may contain optional flag, width, and precision
+modifiers, as follows:
+
+ %<flags><width><precision>character
+
+The following flags are allowed:
+
+* 0: Pad to the width, if given, with zeros instead of spaces.
+* -: Pad to the width, if given, on the right instead of the left.
+* <: Truncate to the width and precision, if given, on the left.
+* >: Truncate to the width and precision, if given, on the right.
+* ^: Convert to upper case.
+* _: Convert to lower case.
+
+The width and truncation modifiers behave like the corresponding
+ones in `format' when applied to %s.
+
+For example, \"%<010b\" means \"substitute into the output the
+value associated with ?b in SPECIFICATION, either padding it with
+leading zeros or truncating leading characters until it's ten
+characters wide\".
+
+Any text properties of FORMAT are copied to the result, with any
+text properties of a %-spec itself copied to its substitution.
+
+IGNORE-MISSING indicates how to handle %-spec characters not
+present in SPECIFICATION. If it is nil or omitted, emit an
+error; if it is the symbol `ignore', leave those %-specs verbatim
+in the result, including their text properties, if any; if it is
+the symbol `delete', remove those %-specs from the result;
+otherwise do the same as for the symbol `ignore', but also leave
+any occurrences of \"%%\" in FORMAT verbatim in the result.
+
+\(fn FORMAT SPECIFICATION &optional IGNORE-MISSING)" nil nil)
+
+(register-definition-prefixes "format-spec" '("format-spec-"))
;;;***
@@ -13420,7 +13291,7 @@ Visit a file in Forms mode in other window.
\(fn FN)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "forms" '("forms-")))
+(register-definition-prefixes "forms" '("forms-"))
;;;***
@@ -13499,7 +13370,7 @@ with no args, if that value is non-nil.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fortran" '("fortran-")))
+(register-definition-prefixes "fortran" '("fortran-"))
;;;***
@@ -13556,7 +13427,7 @@ and choose the directory as the fortune-file.
\(fn &optional FILE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fortune" '("fortune-")))
+(register-definition-prefixes "fortune" '("fortune-"))
;;;***
@@ -13567,7 +13438,7 @@ and choose the directory as the fortune-file.
Minimum set of parameters to filter for live (on-session) framesets.
DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
-(defvar frameset-persistent-filter-alist (nconc '((background-color . frameset-filter-sanitize-color) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (client . :never) (delete-before . :never) (font . frameset-filter-font-param) (font-backend . :never) (foreground-color . frameset-filter-sanitize-color) (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (outer-window-id . :never) (parent-frame . :never) (parent-id . :never) (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-id . :never) (window-system . :never)) frameset-session-filter-alist) "\
+(defvar frameset-persistent-filter-alist (append '((background-color . frameset-filter-sanitize-color) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (client . :never) (delete-before . :never) (font . frameset-filter-font-param) (font-backend . :never) (foreground-color . frameset-filter-sanitize-color) (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (outer-window-id . :never) (parent-frame . :never) (parent-id . :never) (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-id . :never) (window-system . :never)) frameset-session-filter-alist) "\
Parameters to filter for persistent framesets.
DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
@@ -13732,7 +13603,7 @@ Interactively, reads the register using `register-read-with-preview'.
\(fn REGISTER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "frameset" '("frameset-")))
+(register-definition-prefixes "frameset" '("frameset-"))
;;;***
@@ -13741,22 +13612,21 @@ Interactively, reads the register using `register-read-with-preview'.
(unless (fboundp 'define-fringe-bitmap) (defun define-fringe-bitmap (_bitmap _bits &optional _height _width _align) "Define fringe bitmap BITMAP from BITS of size HEIGHT x WIDTH.\nBITMAP is a symbol identifying the new fringe bitmap.\nBITS is either a string or a vector of integers.\nHEIGHT is height of bitmap. If HEIGHT is nil, use length of BITS.\nWIDTH must be an integer between 1 and 16, or nil which defaults to 8.\nOptional fifth arg ALIGN may be one of ‘top’, ‘center’, or ‘bottom’,\nindicating the positioning of the bitmap relative to the rows where it\nis used; the default is to center the bitmap. Fifth arg may also be a\nlist (ALIGN PERIODIC) where PERIODIC non-nil specifies that the bitmap\nshould be repeated.\nIf BITMAP already exists, the existing definition is replaced."))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "fringe" '("fringe-" "set-fringe-")))
+(register-definition-prefixes "fringe" '("fringe-" "set-fringe-"))
;;;***
;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (0 0 0 0))
;;; Generated autoloads from play/gamegrid.el
-(push (purecopy '(gamegrid 1 2)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gamegrid" '("gamegrid-")))
+(register-definition-prefixes "gamegrid" '("gamegrid-"))
;;;***
;;;### (autoloads nil "gametree" "play/gametree.el" (0 0 0 0))
;;; Generated autoloads from play/gametree.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gametree" '("gametree-")))
+(register-definition-prefixes "gametree" '("gametree-"))
;;;***
@@ -13778,10 +13648,16 @@ being transferred. This list may grow up to a size of
`gdb-debug-log-max' after which the oldest element (at the end of
the list) is deleted every time a new one is added (at the front).
-If called interactively, enable Gdb-Enable-Debug mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Gdb-Enable-Debug mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
@@ -13845,7 +13721,7 @@ detailed description of this mode.
\(fn COMMAND-LINE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gdb-mi" '("breakpoint" "def-gdb-" "gdb" "gud-" "hollow-right-triangle" "nil")))
+(register-definition-prefixes "gdb-mi" '("breakpoint" "def-gdb-" "gdb" "gud-" "hollow-right-triangle" "nil"))
;;;***
@@ -13853,7 +13729,7 @@ detailed description of this mode.
;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/generator.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "generator" '("cps-" "iter-")))
+(register-definition-prefixes "generator" '("cps-" "iter-"))
;;;***
@@ -13868,6 +13744,10 @@ instead (which see).")
(autoload 'define-generic-mode "generic" "\
Create a new generic mode MODE.
+A \"generic\" mode is a simple major mode with basic support for
+comment syntax and Font Lock mode, but otherwise does not have
+any special keystrokes or functionality available.
+
MODE is the name of the command for the generic mode; don't quote it.
The optional DOCSTRING is the documentation for the mode command. If
you do not supply it, `define-generic-mode' uses a default
@@ -13935,14 +13815,14 @@ regular expression that can be used as an element of
(make-obsolete 'generic-make-keywords-list 'regexp-opt '"24.4")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "generic" '("generic-")))
+(register-definition-prefixes "generic" '("generic-"))
;;;***
;;;### (autoloads nil "generic-x" "generic-x.el" (0 0 0 0))
;;; Generated autoloads from generic-x.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "generic-x" '("default-generic-mode" "generic-")))
+(register-definition-prefixes "generic-x" '("default-generic-mode" "generic-"))
;;;***
@@ -13952,17 +13832,23 @@ regular expression that can be used as an element of
(autoload 'glasses-mode "glasses" "\
Minor mode for making identifiers likeThis readable.
-If called interactively, enable Glasses mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Glasses mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When this mode is active, it tries to add virtual
separators (like underscores) at places they belong to.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "glasses" '("glasses-")))
+(register-definition-prefixes "glasses" '("glasses-"))
;;;***
@@ -14018,18 +13904,22 @@ DEFAULT-MAP specifies the default key map for ICON-LIST.
\(fn ICON-LIST ZAP-LIST DEFAULT-MAP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gmm-utils" '("defun-gmm" "gmm-")))
+(register-definition-prefixes "gmm-utils" '("defun-gmm" "gmm-"))
;;;***
;;;### (autoloads nil "gnus" "gnus/gnus.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus.el
(push (purecopy '(gnus 5 13)) package--builtin-versions)
-(when (fboundp 'custom-autoload)
- (custom-autoload 'gnus-select-method "gnus"))
+(custom-autoload 'gnus-select-method "gnus")
+
+(autoload 'gnus-child-no-server "gnus" "\
+Read network news as a child, without connecting to the local server.
+
+\(fn &optional ARG)" t nil)
(autoload 'gnus-slave-no-server "gnus" "\
-Read network news as a slave, without connecting to the local server.
+Read network news as a child, without connecting to the local server.
\(fn &optional ARG)" t nil)
@@ -14042,10 +13932,15 @@ an NNTP server to use.
As opposed to `gnus', this command will not connect to the local
server.
-\(fn &optional ARG SLAVE)" t nil)
+\(fn &optional ARG CHILD)" t nil)
+
+(autoload 'gnus-child "gnus" "\
+Read news as a child.
+
+\(fn &optional ARG)" t nil)
(autoload 'gnus-slave "gnus" "\
-Read news as a slave.
+Read news as a child.
\(fn &optional ARG)" t nil)
@@ -14068,9 +13963,9 @@ If ARG is non-nil and a positive number, Gnus will use that as the
startup level. If ARG is non-nil and not a positive number, Gnus will
prompt the user for the name of an NNTP server to use.
-\(fn &optional ARG DONT-CONNECT SLAVE)" t nil)
+\(fn &optional ARG DONT-CONNECT CHILD)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus" '("gnus-")))
+(register-definition-prefixes "gnus" '("gnus-"))
;;;***
@@ -14083,8 +13978,13 @@ Start Gnus unplugged." t nil)
(autoload 'gnus-plugged "gnus-agent" "\
Start Gnus plugged." t nil)
+(autoload 'gnus-child-unplugged "gnus-agent" "\
+Read news as a child unplugged.
+
+\(fn &optional ARG)" t nil)
+
(autoload 'gnus-slave-unplugged "gnus-agent" "\
-Read news as a slave unplugged.
+Read news as a child unplugged.
\(fn &optional ARG)" t nil)
@@ -14148,7 +14048,7 @@ CLEAN is obsolete and ignored.
\(fn &optional CLEAN REREAD)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-agent" '("gnus-")))
+(register-definition-prefixes "gnus-agent" '("gnus-"))
;;;***
@@ -14158,21 +14058,21 @@ CLEAN is obsolete and ignored.
(autoload 'gnus-article-prepare-display "gnus-art" "\
Make the current buffer look like a nice article." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-art" '("article-" "gnus-")))
+(register-definition-prefixes "gnus-art" '("article-" "gnus-"))
;;;***
;;;### (autoloads nil "gnus-async" "gnus/gnus-async.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-async.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-async" '("gnus-")))
+(register-definition-prefixes "gnus-async" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-bcklg" "gnus/gnus-bcklg.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-bcklg.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-bcklg" '("gnus-backlog-")))
+(register-definition-prefixes "gnus-bcklg" '("gnus-backlog-"))
;;;***
@@ -14194,7 +14094,7 @@ The list is displayed in a buffer named `*Gnus Bookmark List*'.
The leftmost column displays a D if the bookmark is flagged for
deletion, or > if it is flagged for displaying." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-bookmark" '("gnus-bookmark-")))
+(register-definition-prefixes "gnus-bookmark" '("gnus-bookmark-"))
;;;***
@@ -14235,28 +14135,35 @@ supported.
\(fn GROUP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cache" '("gnus-")))
+(register-definition-prefixes "gnus-cache" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-cite" "gnus/gnus-cite.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-cite.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cite" '("gnus-" "turn-o")))
+(register-definition-prefixes "gnus-cite" '("gnus-" "turn-o"))
;;;***
;;;### (autoloads nil "gnus-cloud" "gnus/gnus-cloud.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-cloud.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cloud" '("gnus-cloud-")))
+(register-definition-prefixes "gnus-cloud" '("gnus-cloud-"))
;;;***
;;;### (autoloads nil "gnus-cus" "gnus/gnus-cus.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-cus.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-cus" '("category-fields" "gnus-")))
+(register-definition-prefixes "gnus-cus" '("category-fields" "gnus-"))
+
+;;;***
+
+;;;### (autoloads nil "gnus-dbus" "gnus/gnus-dbus.el" (0 0 0 0))
+;;; Generated autoloads from gnus/gnus-dbus.el
+
+(register-definition-prefixes "gnus-dbus" '("gnus-dbus-"))
;;;***
@@ -14276,6 +14183,10 @@ DELAY is a string, giving the length of the time. Possible values are:
* hh:mm for a specific time. Use 24h format. If it is later than this
time, then the deadline is tomorrow, else today.
+The value of `message-draft-headers' determines which headers are
+generated when the article is delayed. Remaining headers are
+generated when the article is sent.
+
\(fn DELAY)" t nil)
(autoload 'gnus-delay-send-queue "gnus-delay" "\
@@ -14291,14 +14202,14 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil.
\(fn &optional NO-KEYMAP NO-CHECK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-delay" '("gnus-delay-")))
+(register-definition-prefixes "gnus-delay" '("gnus-delay-"))
;;;***
;;;### (autoloads nil "gnus-demon" "gnus/gnus-demon.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-demon.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-demon" '("gnus-")))
+(register-definition-prefixes "gnus-demon" '("gnus-"))
;;;***
@@ -14315,7 +14226,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil.
\(fn HEADER)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-diary" '("gnus-")))
+(register-definition-prefixes "gnus-diary" '("gnus-"))
;;;***
@@ -14325,7 +14236,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil.
(autoload 'turn-on-gnus-dired-mode "gnus-dired" "\
Convenience method to turn on gnus-dired-mode." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-dired" '("gnus-dired-")))
+(register-definition-prefixes "gnus-dired" '("gnus-dired-"))
;;;***
@@ -14335,21 +14246,21 @@ Convenience method to turn on gnus-dired-mode." t nil)
(autoload 'gnus-draft-reminder "gnus-draft" "\
Reminder user if there are unsent drafts." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-draft" '("gnus-")))
+(register-definition-prefixes "gnus-draft" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-dup" "gnus/gnus-dup.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-dup.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-dup" '("gnus-")))
+(register-definition-prefixes "gnus-dup" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-eform" "gnus/gnus-eform.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-eform.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-eform" '("gnus-edit-form")))
+(register-definition-prefixes "gnus-eform" '("gnus-edit-form"))
;;;***
@@ -14408,7 +14319,7 @@ Files matching `gnus-face-omit-files' are not considered." t nil)
(autoload 'gnus-insert-random-face-header "gnus-fun" "\
Insert a random Face header from `gnus-face-directory'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-fun" '("gnus-")))
+(register-definition-prefixes "gnus-fun" '("gnus-"))
;;;***
@@ -14428,7 +14339,7 @@ If gravatars are already displayed, remove them.
\(fn &optional FORCE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-gravatar" '("gnus-gravatar-")))
+(register-definition-prefixes "gnus-gravatar" '("gnus-gravatar-"))
;;;***
@@ -14454,7 +14365,7 @@ The arguments have the same meaning as those of
\(fn IDS &optional WINDOW-CONF)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-group" '("gnus-")))
+(register-definition-prefixes "gnus-group" '("gnus-"))
;;;***
@@ -14471,7 +14382,7 @@ The arguments have the same meaning as those of
\(fn SUMMARY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-html" '("gnus-")))
+(register-definition-prefixes "gnus-html" '("gnus-"))
;;;***
@@ -14484,14 +14395,14 @@ The arguments have the same meaning as those of
\(fn HANDLE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-icalendar" '("gnus-icalendar")))
+(register-definition-prefixes "gnus-icalendar" '("gnus-icalendar"))
;;;***
;;;### (autoloads nil "gnus-int" "gnus/gnus-int.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-int.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-int" '("gnus-")))
+(register-definition-prefixes "gnus-int" '("gnus-"))
;;;***
@@ -14504,21 +14415,21 @@ The arguments have the same meaning as those of
Run batched scoring.
Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-kill" '("gnus-")))
+(register-definition-prefixes "gnus-kill" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-logic" "gnus/gnus-logic.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-logic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-logic" '("gnus-")))
+(register-definition-prefixes "gnus-logic" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-mh" "gnus/gnus-mh.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-mh.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-mh" '("gnus-")))
+(register-definition-prefixes "gnus-mh" '("gnus-"))
;;;***
@@ -14536,16 +14447,22 @@ If FORCE is non-nil, replace the old ones.
(autoload 'gnus-mailing-list-mode "gnus-ml" "\
Minor mode for providing mailing-list commands.
-If called interactively, enable Gnus-Mailing-List mode if ARG is
-positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and
-toggle it if ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Gnus-Mailing-List mode'. If the
+prefix argument is positive, enable the mode, and if it is zero
+or negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+All other values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when
+it is disabled.
\\{gnus-mailing-list-mode-map}
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-ml" '("gnus-mailing-list-")))
+(register-definition-prefixes "gnus-ml" '("gnus-mailing-list-"))
;;;***
@@ -14644,7 +14561,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
\(fn &optional GROUPS NO-CROSSPOST CATCH-ALL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-mlspl" '("gnus-group-split-")))
+(register-definition-prefixes "gnus-mlspl" '("gnus-group-split-"))
;;;***
@@ -14672,7 +14589,7 @@ Like `message-reply'.
(define-mail-user-agent 'gnus-user-agent 'gnus-msg-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-msg" '("gnus-")))
+(register-definition-prefixes "gnus-msg" '("gnus-"))
;;;***
@@ -14689,7 +14606,7 @@ notification using `notifications-notify' for it.
This is typically a function to add in
`gnus-after-getting-new-news-hook'" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-notifications" '("gnus-notifications-")))
+(register-definition-prefixes "gnus-notifications" '("gnus-notifications-"))
;;;***
@@ -14708,7 +14625,7 @@ If picons are already displayed, remove them." t nil)
Display picons in the Newsgroups and Followup-To headers.
If picons are already displayed, remove them." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-picon" '("gnus-picon-")))
+(register-definition-prefixes "gnus-picon" '("gnus-picon-"))
;;;***
@@ -14777,7 +14694,7 @@ Add NUM into sorted LIST by side effect.
\(fn LIST NUM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-range" '("gnus-")))
+(register-definition-prefixes "gnus-range" '("gnus-"))
;;;***
@@ -14788,7 +14705,7 @@ Add NUM into sorted LIST by side effect.
(autoload 'gnus-registry-initialize "gnus-registry" "\
Initialize the Gnus registry." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-registry" '("gnus-")))
+(register-definition-prefixes "gnus-registry" '("gnus-"))
;;;***
@@ -14796,21 +14713,21 @@ Initialize the Gnus registry." t nil)
;;;;;; 0 0))
;;; Generated autoloads from gnus/gnus-rfc1843.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-rfc1843" '("rfc1843-")))
+(register-definition-prefixes "gnus-rfc1843" '("rfc1843-"))
;;;***
;;;### (autoloads nil "gnus-salt" "gnus/gnus-salt.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-salt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-salt" '("gnus-")))
+(register-definition-prefixes "gnus-salt" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-score" "gnus/gnus-score.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-score.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-score" '("gnus-")))
+(register-definition-prefixes "gnus-score" '("gnus-"))
;;;***
@@ -14832,7 +14749,7 @@ See the documentation for these variables and functions for details." t nil)
(autoload 'gnus-sieve-article-add-rule "gnus-sieve" nil t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-sieve" '("gnus-sieve-")))
+(register-definition-prefixes "gnus-sieve" '("gnus-sieve-"))
;;;***
@@ -14844,14 +14761,14 @@ Update the format specification near point.
\(fn VAR)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-spec" '("gnus-")))
+(register-definition-prefixes "gnus-spec" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-srvr" "gnus/gnus-srvr.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-srvr.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-srvr" '("gnus-")))
+(register-definition-prefixes "gnus-srvr" '("gnus-"))
;;;***
@@ -14863,7 +14780,7 @@ Declare back end NAME with ABILITIES as a Gnus back end.
\(fn NAME &rest ABILITIES)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-start" '("gnus-")))
+(register-definition-prefixes "gnus-start" '("gnus-"))
;;;***
@@ -14876,42 +14793,42 @@ BOOKMARK is a bookmark name or a bookmark record.
\(fn BOOKMARK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-sum" '("gnus-")))
+(register-definition-prefixes "gnus-sum" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-topic" "gnus/gnus-topic.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-topic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-topic" '("gnus-")))
+(register-definition-prefixes "gnus-topic" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-undo" "gnus/gnus-undo.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-undo.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-undo" '("gnus-")))
+(register-definition-prefixes "gnus-undo" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-util" "gnus/gnus-util.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-util" '("gnus-")))
+(register-definition-prefixes "gnus-util" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-uu" "gnus/gnus-uu.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-uu.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-uu" '("gnus-")))
+(register-definition-prefixes "gnus-uu" '("gnus-"))
;;;***
;;;### (autoloads nil "gnus-vm" "gnus/gnus-vm.el" (0 0 0 0))
;;; Generated autoloads from gnus/gnus-vm.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-vm" '("gnus-")))
+(register-definition-prefixes "gnus-vm" '("gnus-"))
;;;***
@@ -14923,14 +14840,14 @@ Add the window configuration CONF to `gnus-buffer-configuration'.
\(fn CONF)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus-win" '("gnus-")))
+(register-definition-prefixes "gnus-win" '("gnus-"))
;;;***
;;;### (autoloads nil "gnutls" "net/gnutls.el" (0 0 0 0))
;;; Generated autoloads from net/gnutls.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnutls" '("gnutls-" "open-gnutls-stream")))
+(register-definition-prefixes "gnutls" '("gnutls-" "open-gnutls-stream"))
;;;***
@@ -14958,7 +14875,7 @@ Use \\[describe-mode] for more info.
\(fn &optional N M)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gomoku" '("gomoku-")))
+(register-definition-prefixes "gomoku" '("gomoku-"))
;;;***
@@ -14987,24 +14904,62 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
(autoload 'goto-address-mode "goto-addr" "\
Minor mode to buttonize URLs and e-mail addresses in the current buffer.
-If called interactively, enable Goto-Address mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Goto-Address mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+\(fn &optional ARG)" t nil)
+
+(put 'global-goto-address-mode 'globalized-minor-mode t)
+
+(defvar global-goto-address-mode nil "\
+Non-nil if Global Goto-Address mode is enabled.
+See the `global-goto-address-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `global-goto-address-mode'.")
+
+(custom-autoload 'global-goto-address-mode "goto-addr" nil)
+
+(autoload 'global-goto-address-mode "goto-addr" "\
+Toggle Goto-Address mode in all buffers.
+With prefix ARG, enable Global Goto-Address mode if ARG is positive;
+otherwise, disable it. If called from Lisp, enable the mode if
+ARG is omitted or nil.
+
+Goto-Address mode is enabled in all buffers where
+`goto-addr-mode--turn-on' would do it.
+
+See `goto-address-mode' for more information on
+Goto-Address mode.
\(fn &optional ARG)" t nil)
(autoload 'goto-address-prog-mode "goto-addr" "\
Like `goto-address-mode', but only for comments and strings.
-If called interactively, enable Goto-Address-Prog mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Goto-Address-Prog mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "goto-addr" '("goto-address-")))
+(register-definition-prefixes "goto-addr" '("goto-addr"))
;;;***
@@ -15026,7 +14981,7 @@ retrieval failed.
\(fn MAIL-ADDRESS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gravatar" '("gravatar-")))
+(register-definition-prefixes "gravatar" '("gravatar-"))
;;;***
@@ -15054,7 +15009,12 @@ by `grep-compute-defaults'; to change the default value, use
The default find command for \\[grep-find].
In interactive usage, the actual value of this variable is set up
by `grep-compute-defaults'; to change the default value, use
-\\[customize] or call the function `grep-apply-setting'.")
+\\[customize] or call the function `grep-apply-setting'.
+
+This variable can either be a string, or a cons of the
+form (COMMAND . POSITION). In the latter case, COMMAND will be
+used as the default command, and point will be placed at POSITION
+for easier editing.")
(custom-autoload 'grep-find-command "grep" nil)
@@ -15214,14 +15174,14 @@ command before it's run.
(defalias 'rzgrep 'zrgrep)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "grep" '("grep-" "kill-grep" "rgrep-")))
+(register-definition-prefixes "grep" '("grep-" "kill-grep" "rgrep-"))
;;;***
;;;### (autoloads nil "gssapi" "gnus/gssapi.el" (0 0 0 0))
;;; Generated autoloads from gnus/gssapi.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gssapi" '("gssapi-program" "open-gssapi-stream")))
+(register-definition-prefixes "gssapi" '("gssapi-program" "open-gssapi-stream"))
;;;***
@@ -15326,14 +15286,20 @@ or call the function `gud-tooltip-mode'.")
(autoload 'gud-tooltip-mode "gud" "\
Toggle the display of GUD tooltips.
-If called interactively, enable Gud-Tooltip mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Gud-Tooltip mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gud" '("gdb-" "gud-")))
+(register-definition-prefixes "gud" '("gdb-" "gud-"))
;;;***
@@ -15382,9 +15348,13 @@ arguments as NAME. DO is a function as defined in `gv-get'.
\(fn SYMBOL NAME ARGS HANDLER &optional FIX)" nil nil)
-(or (assq 'gv-expander defun-declarations-alist) (let ((x `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander)))) (push x macro-declarations-alist) (push x defun-declarations-alist)))
+(defsubst gv--expander-defun-declaration (&rest args) (apply #'gv--defun-declaration 'gv-expander args))
-(or (assq 'gv-setter defun-declarations-alist) (push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter)) defun-declarations-alist))
+(defsubst gv--setter-defun-declaration (&rest args) (apply #'gv--defun-declaration 'gv-setter args))
+
+(or (assq 'gv-expander defun-declarations-alist) (let ((x (list 'gv-expander #'gv--expander-defun-declaration))) (push x macro-declarations-alist) (push x defun-declarations-alist)))
+
+(or (assq 'gv-setter defun-declarations-alist) (push (list 'gv-setter #'gv--setter-defun-declaration) defun-declarations-alist))
(autoload 'gv-define-setter "gv" "\
Define a setter method for generalized variable NAME.
@@ -15437,7 +15407,7 @@ binding mode.
\(fn PLACE)" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gv" '("gv-")))
+(register-definition-prefixes "gv" '("gv-"))
;;;***
@@ -15454,7 +15424,7 @@ Variables: `handwrite-linespace' (default 12)
`handwrite-numlines' (default 60)
`handwrite-pagenumbering' (default nil)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "handwrite" '("handwrite-" "menu-bar-handwrite-map")))
+(register-definition-prefixes "handwrite" '("handwrite-" "menu-bar-handwrite-map"))
;;;***
@@ -15462,7 +15432,7 @@ Variables: `handwrite-linespace' (default 12)
;;;;;; 0 0))
;;; Generated autoloads from language/hanja-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hanja-util" '("han")))
+(register-definition-prefixes "hanja-util" '("han"))
;;;***
@@ -15487,7 +15457,7 @@ This is, necessarily (as of Emacs 20.3), a crock. When the
current-time interface is made s2G-compliant, hanoi.el will need
to be updated." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hanoi" '("hanoi-")))
+(register-definition-prefixes "hanoi" '("hanoi-"))
;;;***
@@ -15531,7 +15501,7 @@ Prefix arg sets default accept amount temporarily.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hashcash" '("hashcash-")))
+(register-definition-prefixes "hashcash" '("hashcash-"))
;;;***
@@ -15561,6 +15531,9 @@ the `kbd-help' property at point. If `kbd-help' does not produce
a string, but the `help-echo' property does, then that string is
printed instead.
+The string is passed through `substitute-command-keys' before it
+is displayed.
+
A numeric argument ARG prevents display of a message in case
there is no help. While ARG can be used interactively, it is
mainly meant for use from Lisp.
@@ -15587,6 +15560,10 @@ included in this list. Suggested properties are `keymap',
`local-map', `button' and `kbd-help'. Any value other than t or
a non-empty list disables the feature.
+The text printed from the `help-echo' property is often only
+relevant when using the mouse. The presence of a `kbd-help'
+property guarantees that non mouse specific help is available.
+
This variable only takes effect after a call to
`help-at-pt-set-timer'. The help gets printed after Emacs has
been idle for `help-at-pt-timer-delay' seconds. You can call
@@ -15654,7 +15631,7 @@ different regions. With numeric argument ARG, behaves like
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-at-pt" '("help-at-pt-" "scan-buf-move-hook")))
+(register-definition-prefixes "help-at-pt" '("help-at-pt-" "scan-buf-move-hook"))
;;;***
@@ -15746,6 +15723,43 @@ BUFFER should be a buffer or a buffer name.
\(fn &optional BUFFER)" t nil)
+(autoload 'describe-keymap "help-fns" "\
+Describe key bindings in KEYMAP.
+When called interactively, prompt for a variable that has a
+keymap value.
+
+\(fn KEYMAP)" t nil)
+
+(autoload 'describe-mode "help-fns" "\
+Display documentation of current major mode and minor modes.
+A brief summary of the minor modes comes first, followed by the
+major mode description. This is followed by detailed
+descriptions of the minor modes, each on a separate page.
+
+For this to work correctly for a minor mode, the mode's indicator
+variable (listed in `minor-mode-alist') must also be a function
+whose documentation describes the minor mode.
+
+If called from Lisp with a non-nil BUFFER argument, display
+documentation for the major and minor modes of that buffer.
+
+\(fn &optional BUFFER)" t nil)
+
+(autoload 'describe-widget "help-fns" "\
+Display a buffer with information about a widget.
+You can use this command to describe buttons (e.g., the links in a *Help*
+buffer), editable fields of the customization buffers, etc.
+
+Interactively, click on a widget to describe it, or hit RET to describe the
+widget at point.
+
+When called from Lisp, POS may be a buffer position or a mouse position list.
+
+Calls each function of the list `describe-widget-functions' in turn, until
+one of them returns non-nil.
+
+\(fn &optional POS)" t nil)
+
(autoload 'doc-file-to-man "help-fns" "\
Produce an nroff buffer containing the doc-strings from the DOC file.
@@ -15756,7 +15770,7 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file.
\(fn FILE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-fns" '("describe-" "help-")))
+(register-definition-prefixes "help-fns" '("describe-" "help-"))
;;;***
@@ -15772,7 +15786,7 @@ gives the window that lists the options.")
(custom-autoload 'three-step-help "help-macro" t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-macro" '("make-help-screen")))
+(register-definition-prefixes "help-macro" '("make-help-screen"))
;;;***
@@ -15788,10 +15802,10 @@ Commands:
\(fn)" t nil)
(autoload 'help-mode-setup "help-mode" "\
-Enter Help Mode in the current buffer." nil nil)
+Enter Help mode in the current buffer." nil nil)
(autoload 'help-mode-finish "help-mode" "\
-Finalize Help Mode setup in current buffer." nil nil)
+Finalize Help mode setup in current buffer." nil nil)
(autoload 'help-setup-xref "help-mode" "\
Invoked from commands using the \"*Help*\" buffer to install some xref info.
@@ -15869,7 +15883,7 @@ BOOKMARK is a bookmark name or a bookmark record.
\(fn BOOKMARK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "help-mode" '("describe-symbol-backends" "help-")))
+(register-definition-prefixes "help-mode" '("describe-symbol-backends" "help-"))
;;;***
@@ -15882,14 +15896,14 @@ Describe local key bindings of current mode." t nil)
(autoload 'Helper-help "helper" "\
Provide help for current mode." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "helper" '("Helper-")))
+(register-definition-prefixes "helper" '("Helper-"))
;;;***
;;;### (autoloads nil "hex-util" "hex-util.el" (0 0 0 0))
;;; Generated autoloads from hex-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hex-util" '("decode-hex-string" "encode-hex-string")))
+(register-definition-prefixes "hex-util" '("decode-hex-string" "encode-hex-string"))
;;;***
@@ -15983,15 +15997,7 @@ and edit the file in `hexl-mode'.
Convert a binary buffer to hexl format.
This discards the buffer's undo information." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hexl" '("dehexlify-buffer" "hexl-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "hfy-cmap" "hfy-cmap.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from hfy-cmap.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hfy-cmap" '("hfy-" "htmlfontify-unload-rgb-file")))
+(register-definition-prefixes "hexl" '("dehexlify-buffer" "hexl-"))
;;;***
@@ -16001,10 +16007,16 @@ This discards the buffer's undo information." t nil)
(autoload 'hi-lock-mode "hi-lock" "\
Toggle selective highlighting of patterns (Hi Lock mode).
-If called interactively, enable Hi-Lock mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Hi-Lock mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Hi Lock mode is automatically enabled when you invoke any of the
highlighting commands listed below, such as \\[highlight-regexp].
@@ -16088,7 +16100,9 @@ ARG is omitted or nil.
Hi-Lock mode is enabled in all buffers where
`turn-on-hi-lock-if-enabled' would do it.
-See `hi-lock-mode' for more information on Hi-Lock mode.
+
+See `hi-lock-mode' for more information on
+Hi-Lock mode.
\(fn &optional ARG)" t nil)
@@ -16103,6 +16117,9 @@ of text in those lines.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type.
@@ -16118,6 +16135,13 @@ Use the global history list for FACE. Limit face setting to the
corresponding SUBEXP (interactively, the prefix argument) of REGEXP.
If SUBEXP is omitted or nil, the entire REGEXP is highlighted.
+LIGHTER is a human-readable string that can be used to select
+a regexp to unhighlight by its name instead of selecting a possibly
+complex regexp or closure.
+
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type. The Font Lock mode
@@ -16125,7 +16149,7 @@ is considered \"enabled\" in a buffer if its `major-mode'
causes `font-lock-specified-p' to return non-nil, which means
the major mode specifies support for Font Lock.
-\(fn REGEXP &optional FACE SUBEXP)" t nil)
+\(fn REGEXP &optional FACE SUBEXP LIGHTER)" t nil)
(defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
@@ -16134,9 +16158,9 @@ Set face of each match of phrase REGEXP to FACE.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
-When called interactively, replace whitespace in user-provided
-regexp with arbitrary whitespace, and make initial lower-case
-letters case-insensitive, before highlighting with `hi-lock-set-pattern'.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+Also set `search-spaces-regexp' to the value of `search-whitespace-regexp'.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@@ -16155,6 +16179,9 @@ Uses the next face from `hi-lock-face-defaults' without prompting,
unless you use a prefix argument.
Uses `find-tag-default-as-symbol-regexp' to retrieve the symbol at point.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
This uses Font lock mode if it is enabled; otherwise it uses overlays,
in which case the highlighting will not update as you type. The Font
Lock mode is considered \"enabled\" in a buffer if its `major-mode'
@@ -16182,7 +16209,7 @@ be found in variable `hi-lock-interactive-patterns'." t nil)
(autoload 'hi-lock-find-patterns "hi-lock" "\
Add patterns from the current buffer to the list of hi-lock patterns." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hi-lock" '("hi-lock-" "turn-on-hi-lock-if-enabled")))
+(register-definition-prefixes "hi-lock" '("hi-lock-" "turn-on-hi-lock-if-enabled"))
;;;***
@@ -16192,10 +16219,16 @@ Add patterns from the current buffer to the list of hi-lock patterns." t nil)
(autoload 'hide-ifdef-mode "hideif" "\
Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode).
-If called interactively, enable Hide-Ifdef mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Hide-Ifdef mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Hide-Ifdef mode is a buffer-local minor mode for use with C and
C-like major modes. When enabled, code within #ifdef constructs
@@ -16233,14 +16266,14 @@ Several variables affect how the hiding is done:
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "intern-safe" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef")))
+(register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "intern-safe" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef"))
;;;***
;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (0 0 0 0))
;;; Generated autoloads from progmodes/hideshow.el
-(defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil))) "\
+(defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil) (mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil))) "\
Alist for initializing the hideshow variables for different modes.
Each element has the form
(MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
@@ -16271,10 +16304,16 @@ whitespace. Case does not matter.")
(autoload 'hs-minor-mode "hideshow" "\
Minor mode to selectively hide/show code and comment blocks.
-If called interactively, enable Hs minor mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Hs minor mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When hideshow minor mode is on, the menu bar is augmented with hideshow
commands and the hideshow commands are enabled.
@@ -16297,7 +16336,15 @@ Key bindings:
(autoload 'turn-off-hideshow "hideshow" "\
Unconditionally turn off `hs-minor-mode'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hideshow" '("hs-")))
+(register-definition-prefixes "hideshow" '("hs-"))
+
+;;;***
+
+;;;### (autoloads nil "hierarchy" "emacs-lisp/hierarchy.el" (0 0
+;;;;;; 0 0))
+;;; Generated autoloads from emacs-lisp/hierarchy.el
+
+(register-definition-prefixes "hierarchy" '("hierarchy-"))
;;;***
@@ -16307,10 +16354,16 @@ Unconditionally turn off `hs-minor-mode'." nil nil)
(autoload 'highlight-changes-mode "hilit-chg" "\
Toggle highlighting changes in this buffer (Highlight Changes mode).
-If called interactively, enable Highlight-Changes mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Highlight-Changes mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Highlight Changes is enabled, changes are marked with a text
property. Normally they are displayed in a distinctive face, but
@@ -16332,10 +16385,16 @@ buffer with the contents of a file
(autoload 'highlight-changes-visible-mode "hilit-chg" "\
Toggle visibility of highlighting due to Highlight Changes mode.
-If called interactively, enable Highlight-Changes-Visible mode if ARG
-is positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and toggle
-it if ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Highlight-Changes-Visible mode'. If
+the prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Highlight Changes Visible mode only has an effect when Highlight
Changes mode is on. When enabled, the changed text is displayed
@@ -16427,17 +16486,18 @@ ARG is omitted or nil.
Highlight-Changes mode is enabled in all buffers where
`highlight-changes-mode-turn-on' would do it.
-See `highlight-changes-mode' for more information on Highlight-Changes mode.
+
+See `highlight-changes-mode' for more information on
+Highlight-Changes mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hilit-chg" '("global-highlight-changes" "highlight-" "hilit-chg-")))
+(register-definition-prefixes "hilit-chg" '("highlight-" "hilit-chg-"))
;;;***
;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (0 0 0 0))
;;; Generated autoloads from hippie-exp.el
-(push (purecopy '(hippie-exp 1 6)) package--builtin-versions)
(defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\
The list of expansion functions tried in order by `hippie-expand'.
@@ -16465,7 +16525,7 @@ argument VERBOSE non-nil makes the function verbose.
\(fn TRY-LIST &optional VERBOSE)" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hippie-exp" '("he-" "hippie-expand-" "try-")))
+(register-definition-prefixes "hippie-exp" '("he-" "hippie-expand-" "try-"))
;;;***
@@ -16475,10 +16535,16 @@ argument VERBOSE non-nil makes the function verbose.
(autoload 'hl-line-mode "hl-line" "\
Toggle highlighting of the current line (Hl-Line mode).
-If called interactively, enable Hl-Line mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Hl-Line mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Hl-Line mode is a buffer-local minor mode. If
`hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the
@@ -16507,10 +16573,16 @@ or call the function `global-hl-line-mode'.")
(autoload 'global-hl-line-mode "hl-line" "\
Toggle line highlighting in all buffers (Global Hl-Line mode).
-If called interactively, enable Global Hl-Line mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Global Hl-Line mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode
highlights the line about the current buffer's point in all live
@@ -16521,21 +16593,21 @@ and `global-hl-line-maybe-unhighlight' on `post-command-hook'.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hl-line" '("global-hl-line-" "hl-line-")))
+(register-definition-prefixes "hl-line" '("global-hl-line-" "hl-line-"))
;;;***
;;;### (autoloads nil "hmac-def" "net/hmac-def.el" (0 0 0 0))
;;; Generated autoloads from net/hmac-def.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hmac-def" '("define-hmac-function")))
+(register-definition-prefixes "hmac-def" '("define-hmac-function"))
;;;***
;;;### (autoloads nil "hmac-md5" "net/hmac-md5.el" (0 0 0 0))
;;; Generated autoloads from net/hmac-md5.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hmac-md5" '("hmac-md5" "md5-binary")))
+(register-definition-prefixes "hmac-md5" '("hmac-md5" "md5-binary"))
;;;***
@@ -16647,7 +16719,7 @@ The optional LABEL is used to label the buffer created.
(defalias 'holiday-list 'list-holidays)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "holidays" '("calendar-" "holiday-")))
+(register-definition-prefixes "holidays" '("calendar-" "holiday-"))
;;;***
@@ -16683,15 +16755,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'.
\(fn SRCDIR DSTDIR &optional F-EXT L-EXT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "htmlfontify" '("hfy-" "htmlfontify-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ibuf-ext" "ibuf-ext.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from ibuf-ext.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ibuf-ext" '("alphabetic" "basename" "content" "derived-mode" "directory" "eval" "file" "ibuffer-" "major-mode" "mod" "name" "predicate" "print" "process" "query-replace" "rename-uniquely" "replace-regexp" "revert" "shell-command-" "size" "starred-name" "used-mode" "view-and-eval" "visiting-file")))
+(register-definition-prefixes "htmlfontify" '("hfy-" "htmlfontify-"))
;;;***
@@ -16805,7 +16869,7 @@ bound to the current value of the filter.
(function-put 'define-ibuffer-filter 'doc-string-elt '2)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ibuf-macs" '("ibuffer-")))
+(register-definition-prefixes "ibuf-macs" '("ibuffer-"))
;;;***
@@ -16852,14 +16916,13 @@ If optional arg OTHER-WINDOW is non-nil, then use another window.
\(fn &optional OTHER-WINDOW)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ibuffer" '("filename" "ibuffer-" "locked" "mark" "mod" "name" "process" "read-only" "size")))
+(register-definition-prefixes "ibuffer" '("filename" "ibuffer-" "locked" "mark" "mod" "name" "process" "read-only" "size"))
;;;***
;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from calendar/icalendar.el
-(push (purecopy '(icalendar 0 19)) package--builtin-versions)
(autoload 'icalendar-export-file "icalendar" "\
Export diary file to iCalendar format.
@@ -16908,7 +16971,7 @@ buffer `*icalendar-errors*'.
\(fn &optional DIARY-FILENAME DO-NOT-ASK NON-MARKING)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "icalendar" '("icalendar-")))
+(register-definition-prefixes "icalendar" '("icalendar-"))
;;;***
@@ -16928,10 +16991,16 @@ or call the function `fido-mode'.")
(autoload 'fido-mode "icomplete" "\
An enhanced `icomplete-mode' that emulates `ido-mode'.
-If called interactively, enable Fido mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Fido mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
This global minor mode makes minibuffer completion behave
more like `ido-mode' than regular `icomplete-mode'.
@@ -16951,10 +17020,16 @@ or call the function `icomplete-mode'.")
(autoload 'icomplete-mode "icomplete" "\
Toggle incremental minibuffer completion (Icomplete mode).
-If called interactively, enable Icomplete mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Icomplete mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When this global minor mode is enabled, typing in the minibuffer
continuously displays a list of possible completions that match
@@ -16975,7 +17050,7 @@ completions:
(make-obsolete 'iswitchb-mode
"use `icomplete-mode' or `ido-mode' instead." "24.4"))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "icomplete" '("icomplete-")))
+(register-definition-prefixes "icomplete" '("icomplete-"))
;;;***
@@ -17017,7 +17092,7 @@ with no args, if that value is non-nil.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "icon" '("beginning-of-icon-defun" "calculate-icon-indent" "electric-icon-brace" "end-of-icon-defun" "icon-" "indent-icon-exp" "mark-icon-function")))
+(register-definition-prefixes "icon" '("beginning-of-icon-defun" "calculate-icon-indent" "electric-icon-brace" "end-of-icon-defun" "icon-" "indent-icon-exp" "mark-icon-function"))
;;;***
@@ -17025,7 +17100,7 @@ with no args, if that value is non-nil.
;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/idlw-complete-structtag.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-complete-structtag" '("idlwave-")))
+(register-definition-prefixes "idlw-complete-structtag" '("idlwave-"))
;;;***
@@ -17033,7 +17108,7 @@ with no args, if that value is non-nil.
;;;;;; 0))
;;; Generated autoloads from progmodes/idlw-help.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-help" '("idlwave-")))
+(register-definition-prefixes "idlw-help" '("idlwave-"))
;;;***
@@ -17061,7 +17136,7 @@ See also the variable `idlwave-shell-prompt-pattern'.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-shell" '("idlwave-")))
+(register-definition-prefixes "idlw-shell" '("idlwave-"))
;;;***
@@ -17069,7 +17144,7 @@ See also the variable `idlwave-shell-prompt-pattern'.
;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/idlw-toolbar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlw-toolbar" '("idlwave-toolbar-")))
+(register-definition-prefixes "idlw-toolbar" '("idlwave-toolbar-"))
;;;***
@@ -17178,7 +17253,6 @@ The main features of this mode are
8. Hooks
-----
- Loading idlwave.el runs `idlwave-load-hook'.
Turning on `idlwave-mode' runs `idlwave-mode-hook'.
9. Documentation and Customization
@@ -17187,7 +17261,7 @@ The main features of this mode are
\\[idlwave-info] to display (complain to your sysadmin if that does
not work). For Postscript, PDF, and HTML versions of the
documentation, check IDLWAVE's homepage at URL
- `http://github.com/jdtsmith/idlwave'.
+ `https://github.com/jdtsmith/idlwave'.
IDLWAVE has customize support - see the group `idlwave'.
10.Keybindings
@@ -17200,7 +17274,7 @@ The main features of this mode are
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "idlwave" '("idlwave-")))
+(register-definition-prefixes "idlwave" '("idlwave-"))
;;;***
@@ -17460,7 +17534,7 @@ DEF, if non-nil, is the default value.
\(fn PROMPT CHOICES &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ido" '("ido-")))
+(register-definition-prefixes "ido" '("ido-"))
;;;***
@@ -17475,14 +17549,14 @@ See `inferior-emacs-lisp-mode' for details.
\(fn &optional BUF-NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ielm" '("ielm-" "inferior-emacs-lisp-mode")))
+(register-definition-prefixes "ielm" '("ielm-" "inferior-emacs-lisp-mode"))
;;;***
;;;### (autoloads nil "ietf-drums" "mail/ietf-drums.el" (0 0 0 0))
;;; Generated autoloads from mail/ietf-drums.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ietf-drums" '("ietf-drums-")))
+(register-definition-prefixes "ietf-drums" '("ietf-drums-"))
;;;***
@@ -17494,16 +17568,22 @@ See `inferior-emacs-lisp-mode' for details.
(autoload 'iimage-mode "iimage" "\
Toggle Iimage mode on or off.
-If called interactively, enable Iimage mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Iimage mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\\{iimage-mode-map}
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iimage" '("iimage-" "turn-off-iimage-mode")))
+(register-definition-prefixes "iimage" '("iimage-" "turn-off-iimage-mode"))
;;;***
@@ -17703,7 +17783,7 @@ recognizes these files as having image type `imagemagick'.
If Emacs is compiled without ImageMagick support, this does nothing." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image" '("image" "unknown-image-type")))
+(register-definition-prefixes "image" '("image" "unknown-image-type"))
;;;***
@@ -17711,7 +17791,7 @@ If Emacs is compiled without ImageMagick support, this does nothing." nil nil)
;;;;;; (0 0 0 0))
;;; Generated autoloads from image/image-converter.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-converter" '("image-convert")))
+(register-definition-prefixes "image-converter" '("image-convert"))
;;;***
@@ -17802,10 +17882,16 @@ Setup easy-to-use keybindings for the commands to be used in dired mode.
Note that n, p and <down> and <up> will be hijacked and bound to
`image-dired-dired-x-line'.
-If called interactively, enable Image-Dired minor mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Image-Dired minor mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
@@ -17843,7 +17929,7 @@ Edit comment and tags of current or marked image files.
Edit comment and tags for all marked image files in an
easy-to-use form." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-dired" '("image-dired-")))
+(register-definition-prefixes "image-dired" '("image-dired-"))
;;;***
@@ -17898,10 +17984,16 @@ or call the function `auto-image-file-mode'.")
(autoload 'auto-image-file-mode "image-file" "\
Toggle visiting of image files as images (Auto Image File mode).
-If called interactively, enable Auto-Image-File mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Auto-Image-File mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
An image file is one whose name has an extension in
`image-file-name-extensions', or matches a regexp in
@@ -17909,7 +18001,7 @@ An image file is one whose name has an extension in
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-file" '("image-file-")))
+(register-definition-prefixes "image-file" '("image-file-"))
;;;***
@@ -17927,10 +18019,16 @@ Key bindings:
(autoload 'image-minor-mode "image-mode" "\
Toggle Image minor mode in this buffer.
-If called interactively, enable Image minor mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Image minor mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display],
to switch back to `image-mode' and display an image file as the
@@ -17948,14 +18046,14 @@ displays an image file as text." nil nil)
\(fn BMK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "image-mode" '("image-")))
+(register-definition-prefixes "image-mode" '("image-"))
;;;***
;;;### (autoloads nil "imap" "net/imap.el" (0 0 0 0))
;;; Generated autoloads from net/imap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "imap" '("imap-")))
+(register-definition-prefixes "imap" '("imap-"))
;;;***
@@ -18093,7 +18191,7 @@ for more information.
\(fn INDEX-ITEM)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "imenu" '("imenu-")))
+(register-definition-prefixes "imenu" '("imenu-"))
;;;***
@@ -18125,7 +18223,7 @@ Convert old Emacs Devanagari characters to UCS.
\(fn FROM TO)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ind-util" '("indian-" "is13194-")))
+(register-definition-prefixes "ind-util" '("indian-" "is13194-"))
;;;***
@@ -18145,7 +18243,7 @@ of `inferior-lisp-program'). Runs the hooks from
(defalias 'run-lisp 'inferior-lisp)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "inf-lisp" '("inferior-lisp-" "lisp-" "switch-to-lisp")))
+(register-definition-prefixes "inf-lisp" '("inferior-lisp-" "lisp-" "switch-to-lisp"))
;;;***
@@ -18169,7 +18267,7 @@ the environment variable INFOPATH is set.
Although this is a customizable variable, that is mainly for technical
reasons. Normally, you should either set INFOPATH or customize
-`Info-additional-directory-list', rather than changing this variable." :initialize 'custom-initialize-delay :type '(repeat directory) :group 'info)
+`Info-additional-directory-list', rather than changing this variable." :initialize 'custom-initialize-delay :type '(repeat directory))
(autoload 'info-other-window "info" "\
Like `info' but show the Info buffer in another window.
@@ -18288,6 +18386,7 @@ Moving within a node:
already visible, try to go to the previous menu entry, or up
if there is none.
\\[beginning-of-buffer] Go to beginning of node.
+\\[end-of-buffer] Go to end of node.
Advanced commands:
\\[Info-search] Search through this Info file for specified regexp,
@@ -18349,7 +18448,7 @@ completion alternatives to currently visited manuals.
\(fn MANUAL)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "info" '("Info-" "info-")))
+(register-definition-prefixes "info" '("Info-" "info-"))
;;;***
@@ -18396,7 +18495,7 @@ Perform completion on file preceding point.
\(fn &optional MODE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "info-look" '("info-")))
+(register-definition-prefixes "info-look" '("info-"))
;;;***
@@ -18477,7 +18576,7 @@ the sources handy.
\(fn FILENAME-LIST)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "info-xref" '("info-xref-")))
+(register-definition-prefixes "info-xref" '("info-xref-"))
;;;***
@@ -18518,7 +18617,7 @@ Must be used only with -batch, and kills Emacs on completion.
Each file will be processed even if an error occurred previously.
For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "informat" '("Info-validate-")))
+(register-definition-prefixes "informat" '("Info-validate-"))
;;;***
@@ -18537,7 +18636,7 @@ See Info node `(elisp)Defining Functions' for more details.
(function-put 'define-inline 'doc-string-elt '3)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "inline" '("inline-")))
+(register-definition-prefixes "inline" '("inline-"))
;;;***
@@ -18551,7 +18650,7 @@ Only checks one based on which kind of Emacs is being run.
\(fn EMACS-VER XEMACS-VER SXEMACS-VER)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "inversion" '("inversion-")))
+(register-definition-prefixes "inversion" '("inversion-"))
;;;***
@@ -18570,7 +18669,7 @@ Toggle input method in interactive search." t nil)
\(fn LAST-CHAR &optional COUNT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "isearch-x" '("isearch-")))
+(register-definition-prefixes "isearch-x" '("isearch-"))
;;;***
@@ -18584,7 +18683,7 @@ Executing this command again will terminate the search; or, if
the search has not yet begun, will toggle to the last buffer
accessed via isearchb." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "isearchb" '("isearchb")))
+(register-definition-prefixes "isearchb" '("isearchb"))
;;;***
@@ -18592,7 +18691,7 @@ accessed via isearchb." t nil)
;;;;;; 0 0 0))
;;; Generated autoloads from international/iso-ascii.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iso-ascii" '("iso-ascii-")))
+(register-definition-prefixes "iso-ascii" '("iso-ascii-"))
;;;***
@@ -18683,7 +18782,7 @@ Warn that format is write-only.
(autoload 'iso-cvt-define-menu "iso-cvt" "\
Add submenus to the File menu, to convert to and from various formats." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iso-cvt" '("iso-")))
+(register-definition-prefixes "iso-cvt" '("iso-"))
;;;***
@@ -18693,14 +18792,14 @@ Add submenus to the File menu, to convert to and from various formats." t nil)
(define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map)
(autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iso-transl" '("iso-transl-")))
+(register-definition-prefixes "iso-transl" '("iso-transl-"))
;;;***
;;;### (autoloads nil "iso8601" "calendar/iso8601.el" (0 0 0 0))
;;; Generated autoloads from calendar/iso8601.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "iso8601" '("iso8601-")))
+(register-definition-prefixes "iso8601" '("iso8601-"))
;;;***
@@ -18833,7 +18932,16 @@ amount for last line processed.
\(fn REG-START REG-END &optional RECHECKP SHIFT)" t nil)
(autoload 'ispell-comments-and-strings "ispell" "\
-Check comments and strings in the current buffer for spelling errors." t nil)
+Check comments and strings in the current buffer for spelling errors.
+If called interactively with an active region, check only comments and
+strings in the region.
+When called from Lisp, START and END buffer positions can be provided
+to limit the check.
+
+\(fn &optional START END)" t nil)
+
+(autoload 'ispell-comment-or-string-at-point "ispell" "\
+Check the comment or string containing point for spelling errors." t nil)
(autoload 'ispell-buffer "ispell" "\
Check the current buffer for spelling errors interactively." t nil)
@@ -18872,10 +18980,16 @@ available on the net." t nil)
(autoload 'ispell-minor-mode "ispell" "\
Toggle last-word spell checking (Ispell minor mode).
-If called interactively, enable ISpell minor mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `ISpell minor mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Ispell minor mode is a buffer-local minor mode. When enabled,
typing SPC or RET warns you if the previous word is incorrectly
@@ -18908,9 +19022,9 @@ in your init file:
You can bind this to the key C-c i in GNUS or mail by adding to
`news-reply-mode-hook' or `mail-mode-hook' the following lambda expression:
- (function (lambda () (local-set-key \"\\C-ci\" \\='ispell-message)))" t nil)
+ (lambda () (local-set-key \"\\C-ci\" \\='ispell-message))" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ispell" '("check-ispell-version" "ispell-")))
+(register-definition-prefixes "ispell" '("check-ispell-version" "ispell-"))
;;;***
@@ -18918,7 +19032,7 @@ You can bind this to the key C-c i in GNUS or mail by adding to
;;;;;; (0 0 0 0))
;;; Generated autoloads from international/ja-dic-cnv.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ja-dic-cnv" '("batch-skkdic-convert" "ja-dic-filename" "skkdic-")))
+(register-definition-prefixes "ja-dic-cnv" '("batch-skkdic-convert" "ja-dic-filename" "skkdic-"))
;;;***
@@ -18926,7 +19040,7 @@ You can bind this to the key C-c i in GNUS or mail by adding to
;;;;;; (0 0 0 0))
;;; Generated autoloads from international/ja-dic-utl.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ja-dic-utl" '("skkdic-")))
+(register-definition-prefixes "ja-dic-utl" '("skkdic-"))
;;;***
@@ -19003,7 +19117,7 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
\(fn PROMPT &optional INITIAL-INPUT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "japan-util" '("japanese-")))
+(register-definition-prefixes "japan-util" '("japanese-"))
;;;***
@@ -19026,7 +19140,7 @@ This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
and `inhibit-local-variables-suffixes' that were added
by `jka-compr-installed'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "jka-compr" '("compression-error" "jka-compr-")))
+(register-definition-prefixes "jka-compr" '("compression-error" "jka-compr-"))
;;;***
@@ -19057,30 +19171,30 @@ one of the aforementioned options instead of using this mode.
(dolist (name (list "node" "nodejs" "gjs" "rhino")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'js-mode)))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "js" '("js-" "with-js")))
+(register-definition-prefixes "js" '("js-" "with-js"))
;;;***
;;;### (autoloads nil "json" "json.el" (0 0 0 0))
;;; Generated autoloads from json.el
-(push (purecopy '(json 1 4)) package--builtin-versions)
+(push (purecopy '(json 1 5)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "json" '("json-")))
+(register-definition-prefixes "json" '("json-"))
;;;***
;;;### (autoloads nil "jsonrpc" "jsonrpc.el" (0 0 0 0))
;;; Generated autoloads from jsonrpc.el
-(push (purecopy '(jsonrpc 1 0 9)) package--builtin-versions)
+(push (purecopy '(jsonrpc 1 0 12)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "jsonrpc" '("jrpc-default-request-timeout" "jsonrpc-")))
+(register-definition-prefixes "jsonrpc" '("jsonrpc-"))
;;;***
;;;### (autoloads nil "kermit" "kermit.el" (0 0 0 0))
;;; Generated autoloads from kermit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kermit" '("kermit-")))
+(register-definition-prefixes "kermit" '("kermit-"))
;;;***
@@ -19159,7 +19273,7 @@ the context of text formatting.
\(fn LINEBEG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kinsoku" '("kinsoku-")))
+(register-definition-prefixes "kinsoku" '("kinsoku-"))
;;;***
@@ -19183,7 +19297,7 @@ and the return value is the length of the conversion.
\(fn FROM TO)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kkc" '("kkc-")))
+(register-definition-prefixes "kkc" '("kkc-"))
;;;***
@@ -19307,7 +19421,7 @@ Create lambda form for macro bound to symbol or key.
\(fn MAC &optional COUNTER FORMAT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "kmacro" '("kmacro-")))
+(register-definition-prefixes "kmacro" '("kmacro-"))
;;;***
@@ -19321,7 +19435,7 @@ The kind of Korean keyboard for Korean input method.
(autoload 'setup-korean-environment-internal "korea-util" nil nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "korea-util" '("exit-korean-environment" "isearch-" "korean-key-bindings" "quail-hangul-switch-" "toggle-korean-input-method")))
+(register-definition-prefixes "korea-util" '("exit-korean-environment" "isearch-" "korean-key-bindings" "quail-hangul-switch-" "toggle-korean-input-method"))
;;;***
@@ -19360,7 +19474,7 @@ Transcribe Romanized Lao string STR to Lao character string.
\(fn FROM TO)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lao-util" '("lao-")))
+(register-definition-prefixes "lao-util" '("lao-"))
;;;***
@@ -19394,7 +19508,7 @@ coding system names is determined from `latex-inputenc-coding-alist'.
\(fn ARG-LIST)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "latexenc" '("latexenc-dont-use-")))
+(register-definition-prefixes "latexenc" '("latexenc-dont-use-"))
;;;***
@@ -19438,7 +19552,7 @@ use either \\[customize] or the function `latin1-display'.")
(custom-autoload 'latin1-display-ucs-per-lynx "latin1-disp" nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "latin1-disp" '("latin1-display-")))
+(register-definition-prefixes "latin1-disp" '("latin1-display-"))
;;;***
@@ -19451,14 +19565,14 @@ A major mode to edit GNU ld script files
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ld-script" '("ld-script-")))
+(register-definition-prefixes "ld-script" '("ld-script-"))
;;;***
;;;### (autoloads nil "ldap" "net/ldap.el" (0 0 0 0))
;;; Generated autoloads from net/ldap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ldap" '("ldap-")))
+(register-definition-prefixes "ldap" '("ldap-"))
;;;***
@@ -19466,7 +19580,7 @@ A major mode to edit GNU ld script files
;;;;;; (0 0 0 0))
;;; Generated autoloads from gnus/legacy-gnus-agent.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "legacy-gnus-agent" '("gnus-agent-")))
+(register-definition-prefixes "legacy-gnus-agent" '("gnus-agent-"))
;;;***
@@ -19490,7 +19604,7 @@ Special commands:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "less-css-mode" '("less-css-")))
+(register-definition-prefixes "less-css-mode" '("less-css-"))
;;;***
@@ -19532,7 +19646,7 @@ displayed in the example above.
(function-put 'let-alist 'lisp-indent-function '1)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "let-alist" '("let-alist--")))
+(register-definition-prefixes "let-alist" '("let-alist--"))
;;;***
@@ -19541,27 +19655,36 @@ displayed in the example above.
(autoload 'life "life" "\
Run Conway's Life simulation.
-The starting pattern is randomly selected. Prefix arg (optional first
-arg non-nil from a program) is the number of seconds to sleep between
-generations (this defaults to 1).
+The starting pattern is randomly selected from `life-patterns'.
+
+Prefix arg is the number of tenths of a second to sleep between
+generations (the default is `life-step-time').
+
+When called from Lisp, optional argument STEP-TIME is the time to
+sleep in seconds.
-\(fn &optional SLEEPTIME)" t nil)
+\(fn &optional STEP-TIME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "life" '("life-")))
+(register-definition-prefixes "life" '("life-"))
;;;***
;;;### (autoloads nil "linum" "linum.el" (0 0 0 0))
;;; Generated autoloads from linum.el
-(push (purecopy '(linum 0 9 24)) package--builtin-versions)
(autoload 'linum-mode "linum" "\
Toggle display of line numbers in the left margin (Linum mode).
-If called interactively, enable Linum mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Linum mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Linum mode is a buffer-local minor mode.
@@ -19587,11 +19710,13 @@ ARG is omitted or nil.
Linum mode is enabled in all buffers where
`linum-on' would do it.
-See `linum-mode' for more information on Linum mode.
+
+See `linum-mode' for more information on
+Linum mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "linum" '("linum-")))
+(register-definition-prefixes "linum" '("linum-"))
;;;***
@@ -19599,7 +19724,7 @@ See `linum-mode' for more information on Linum mode.
;;;;;; 0))
;;; Generated autoloads from emacs-lisp/lisp-mnt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lisp-mnt" '("lm-")))
+(register-definition-prefixes "lisp-mnt" '("lm-"))
;;;***
@@ -19612,11 +19737,10 @@ If the feature is required by any other loaded code, and prefix arg FORCE
is nil, raise an error.
Standard unloading activities include restoring old autoloads for
-functions defined by the library, undoing any additions that the
-library has made to hook variables or to `auto-mode-alist', undoing
-ELP profiling of functions in that library, unproviding any features
-provided by the library, and canceling timers held in variables
-defined by the library.
+functions defined by the library, removing such functions from
+hooks and `auto-mode-alist', undoing their ELP profiling,
+unproviding any features provided by the library, and canceling
+timers held in variables defined by the library.
If a function `FEATURE-unload-function' is defined, this function
calls it with no arguments, before doing anything else. That function
@@ -19632,7 +19756,7 @@ something strange, such as redefining an Emacs function.
\(fn FEATURE &optional FORCE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "loadhist" '("feature-" "file-" "loadhist-" "read-feature" "unload-")))
+(register-definition-prefixes "loadhist" '("feature-" "file-" "loadhist-" "read-feature" "unload-"))
;;;***
@@ -19686,7 +19810,7 @@ except that FILTER is not optional.
\(fn SEARCH-STRING FILTER &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "locate" '("locate-")))
+(register-definition-prefixes "locate" '("locate-"))
;;;***
@@ -19719,7 +19843,7 @@ done. Otherwise, it uses the current buffer.
\(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "log-edit" '("log-edit-" "vc-log-")))
+(register-definition-prefixes "log-edit" '("log-edit-"))
;;;***
@@ -19731,7 +19855,7 @@ Major mode for browsing CVS log output.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "log-view" '("log-view-")))
+(register-definition-prefixes "log-view" '("log-view-"))
;;;***
@@ -19824,7 +19948,7 @@ for further customization of the printer command.
\(fn START END)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lpr" '("lpr-" "print")))
+(register-definition-prefixes "lpr" '("lpr-" "print"))
;;;***
@@ -19837,7 +19961,7 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).")
(custom-autoload 'ls-lisp-support-shell-wildcards "ls-lisp" t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ls-lisp" '("ls-lisp-")))
+(register-definition-prefixes "ls-lisp" '("ls-lisp-"))
;;;***
@@ -19851,7 +19975,7 @@ This function is suitable for execution in an init file.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lunar" '("calendar-lunar-phases" "diary-lunar-phases" "lunar-")))
+(register-definition-prefixes "lunar" '("calendar-lunar-phases" "diary-lunar-phases" "eclipse-check" "lunar-"))
;;;***
@@ -19863,7 +19987,7 @@ A major mode to edit m4 macro files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "m4-mode" '("m4-")))
+(register-definition-prefixes "m4-mode" '("m4-"))
;;;***
@@ -19948,7 +20072,7 @@ and then select the region of un-tablified names and use
\(fn TOP BOTTOM &optional MACRO)" t nil)
(define-key ctl-x-map "q" 'kbd-macro-query)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "macros" '("macros--insert-vector-macro")))
+(register-definition-prefixes "macros" '("macros--insert-vector-macro"))
;;;***
@@ -19987,7 +20111,7 @@ Convert mail domain DOMAIN to the country it corresponds to.
\(fn DOMAIN)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-extr" '("mail-extr-")))
+(register-definition-prefixes "mail-extr" '("mail-extr-"))
;;;***
@@ -20011,21 +20135,21 @@ message.
This function normally would be called when the message is sent." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-hist" '("mail-hist-")))
+(register-definition-prefixes "mail-hist" '("mail-hist-"))
;;;***
;;;### (autoloads nil "mail-parse" "mail/mail-parse.el" (0 0 0 0))
;;; Generated autoloads from mail/mail-parse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-parse" '("mail-")))
+(register-definition-prefixes "mail-parse" '("mail-"))
;;;***
;;;### (autoloads nil "mail-prsvr" "mail/mail-prsvr.el" (0 0 0 0))
;;; Generated autoloads from mail/mail-prsvr.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-prsvr" '("mail-parse-")))
+(register-definition-prefixes "mail-prsvr" '("mail-parse-"))
;;;***
@@ -20033,7 +20157,7 @@ This function normally would be called when the message is sent." nil nil)
;;;;;; 0))
;;; Generated autoloads from gnus/mail-source.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-source" '("mail-source")))
+(register-definition-prefixes "mail-source" '("mail-source"))
;;;***
@@ -20111,7 +20235,7 @@ matches may be returned from the message body.
\(fn FIELD-NAME &optional LAST ALL LIST DELETE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mail-utils" '("mail-")))
+(register-definition-prefixes "mail-utils" '("mail-"))
;;;***
@@ -20131,10 +20255,16 @@ or call the function `mail-abbrevs-mode'.")
(autoload 'mail-abbrevs-mode "mailabbrev" "\
Toggle abbrev expansion of mail aliases (Mail Abbrevs mode).
-If called interactively, enable Mail-Abbrevs mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Mail-Abbrevs mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Mail Abbrevs mode is a global minor mode. When enabled,
abbrev-like expansion is performed when editing certain mail
@@ -20163,7 +20293,7 @@ double-quotes.
\(fn NAME DEFINITION &optional FROM-MAILRC-FILE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailabbrev" '("mail-" "merge-mail-abbrevs" "rebuild-mail-abbrevs")))
+(register-definition-prefixes "mailabbrev" '("mail-" "merge-mail-abbrevs" "rebuild-mail-abbrevs"))
;;;***
@@ -20216,14 +20346,14 @@ current header, calls `mail-complete-function' and passes prefix ARG if any.
(make-obsolete 'mail-complete 'mail-completion-at-point-function '"24.1")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailalias" '("build-mail-aliases" "mail-")))
+(register-definition-prefixes "mailalias" '("build-mail-aliases" "mail-"))
;;;***
;;;### (autoloads nil "mailcap" "net/mailcap.el" (0 0 0 0))
;;; Generated autoloads from net/mailcap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailcap" '("mailcap-")))
+(register-definition-prefixes "mailcap" '("mailcap-"))
;;;***
@@ -20235,21 +20365,21 @@ Pass current buffer on to the system's mail client.
Suitable value for `send-mail-function'.
The mail client is taken to be the handler of mailto URLs." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailclient" '("mailclient-")))
+(register-definition-prefixes "mailclient" '("mailclient-"))
;;;***
;;;### (autoloads nil "mailheader" "mail/mailheader.el" (0 0 0 0))
;;; Generated autoloads from mail/mailheader.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mailheader" '("mail-header")))
+(register-definition-prefixes "mailheader" '("mail-header"))
;;;***
;;;### (autoloads nil "mairix" "net/mairix.el" (0 0 0 0))
;;; Generated autoloads from net/mairix.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mairix" '("mairix-")))
+(register-definition-prefixes "mairix" '("mairix-"))
;;;***
@@ -20369,14 +20499,14 @@ An adapted `makefile-mode' that knows about imake.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "make-mode" '("makefile-")))
+(register-definition-prefixes "make-mode" '("makefile-"))
;;;***
;;;### (autoloads nil "makeinfo" "textmodes/makeinfo.el" (0 0 0 0))
;;; Generated autoloads from textmodes/makeinfo.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "makeinfo" '("makeinfo-")))
+(register-definition-prefixes "makeinfo" '("makeinfo-"))
;;;***
@@ -20387,7 +20517,7 @@ An adapted `makefile-mode' that knows about imake.
Make a summary of current key bindings in the buffer *Summary*.
Previous contents of that buffer are killed first." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "makesum" '("double-column")))
+(register-definition-prefixes "makesum" '("double-column"))
;;;***
@@ -20449,29 +20579,34 @@ Default bookmark handler for Man buffers.
\(fn BOOKMARK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "man" '("Man-" "man")))
+(register-definition-prefixes "man" '("Man-" "man"))
;;;***
;;;### (autoloads nil "map" "emacs-lisp/map.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/map.el
-(push (purecopy '(map 2 0)) package--builtin-versions)
+(push (purecopy '(map 2 1)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "map" '("map-")))
+(register-definition-prefixes "map" '("map-"))
;;;***
;;;### (autoloads nil "master" "master.el" (0 0 0 0))
;;; Generated autoloads from master.el
-(push (purecopy '(master 1 0 2)) package--builtin-versions)
(autoload 'master-mode "master" "\
Toggle Master mode.
-If called interactively, enable Master mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Master mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Master mode is enabled, you can scroll the slave buffer
using the following commands:
@@ -20484,7 +20619,7 @@ yourself the value of `master-of' by calling `master-show-slave'.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "master" '("master-")))
+(register-definition-prefixes "master" '("master-"))
;;;***
@@ -20504,10 +20639,16 @@ or call the function `minibuffer-depth-indicate-mode'.")
(autoload 'minibuffer-depth-indicate-mode "mb-depth" "\
Toggle Minibuffer Depth Indication mode.
-If called interactively, enable Minibuffer-Depth-Indicate mode if ARG
-is positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and toggle
-it if ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Minibuffer-Depth-Indicate mode'. If
+the prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Minibuffer Depth Indication mode is a global minor mode. When
enabled, any recursive use of the minibuffer will show the
@@ -20516,15 +20657,14 @@ recursion depth in the minibuffer prompt. This is only useful if
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mb-depth" '("minibuffer-depth-")))
+(register-definition-prefixes "mb-depth" '("minibuffer-depth-"))
;;;***
;;;### (autoloads nil "md4" "md4.el" (0 0 0 0))
;;; Generated autoloads from md4.el
-(push (purecopy '(md4 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "md4" '("md4")))
+(register-definition-prefixes "md4" '("md4"))
;;;***
@@ -20650,7 +20790,13 @@ which specify the range to operate on.
\(fn START END)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "message" '("message-" "nil")))
+(autoload 'message-mailto "message" "\
+Command to parse command line mailto: links.
+This is meant to be used for MIME handlers: Setting the handler
+for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\"
+will then start up Emacs ready to compose mail." t nil)
+
+(register-definition-prefixes "message" '("message-" "nil"))
;;;***
@@ -20669,71 +20815,28 @@ Major mode for editing MetaPost sources.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "meta-mode" '("font-lock-match-meta-declaration-item-and-skip-to-next" "meta")))
-
-;;;***
-
-;;;### (autoloads nil "metamail" "mail/metamail.el" (0 0 0 0))
-;;; Generated autoloads from mail/metamail.el
-
-(autoload 'metamail-interpret-header "metamail" "\
-Interpret a header part of a MIME message in current buffer.
-Its body part is not interpreted at all." t nil)
-
-(autoload 'metamail-interpret-body "metamail" "\
-Interpret a body part of a MIME message in current buffer.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted.
-Its header part is not interpreted at all.
-
-\(fn &optional VIEWMODE NODISPLAY)" t nil)
-
-(autoload 'metamail-buffer "metamail" "\
-Process current buffer through `metamail'.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument BUFFER specifies a buffer to be filled (nil
-means current).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted.
-
-\(fn &optional VIEWMODE BUFFER NODISPLAY)" t nil)
-
-(autoload 'metamail-region "metamail" "\
-Process current region through `metamail'.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument BUFFER specifies a buffer to be filled (nil
-means current).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted.
-
-\(fn BEG END &optional VIEWMODE BUFFER NODISPLAY)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "metamail" '("metamail-")))
+(register-definition-prefixes "meta-mode" '("font-lock-match-meta-declaration-item-and-skip-to-next" "meta"))
;;;***
;;;### (autoloads nil "mh-acros" "mh-e/mh-acros.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-acros.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-acros" '("defmacro-mh" "defun-mh" "mh-" "with-mh-folder-updating")))
+(register-definition-prefixes "mh-acros" '("defmacro-mh" "defun-mh" "mh-" "with-mh-folder-updating"))
;;;***
;;;### (autoloads nil "mh-alias" "mh-e/mh-alias.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-alias.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-alias" '("mh-")))
+(register-definition-prefixes "mh-alias" '("mh-"))
;;;***
;;;### (autoloads nil "mh-buffers" "mh-e/mh-buffers.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-buffers.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-buffers" '("mh-")))
+(register-definition-prefixes "mh-buffers" '("mh-"))
;;;***
@@ -20818,14 +20921,14 @@ this command to kill the draft buffer and delete the draft
message. Use the command \\[kill-buffer] if you don't want to
delete the draft message." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-comp" '("mh-")))
+(register-definition-prefixes "mh-comp" '("mh-"))
;;;***
;;;### (autoloads nil "mh-compat" "mh-e/mh-compat.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-compat.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-compat" '("mh-")))
+(register-definition-prefixes "mh-compat" '("mh-"))
;;;***
@@ -20842,7 +20945,7 @@ delete the draft message." t nil)
(autoload 'mh-version "mh-e" "\
Display version information about MH-E and the MH mail handling system." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-e" '("defcustom-mh" "defface-mh" "defgroup-mh" "mh-")))
+(register-definition-prefixes "mh-e" '("defcustom-mh" "defface-mh" "defgroup-mh" "mh-"))
;;;***
@@ -20925,14 +21028,14 @@ perform the operation on all messages in that region.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-folder" '("mh-")))
+(register-definition-prefixes "mh-folder" '("mh-"))
;;;***
;;;### (autoloads nil "mh-funcs" "mh-e/mh-funcs.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-funcs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-funcs" '("mh-")))
+(register-definition-prefixes "mh-funcs" '("mh-"))
;;;***
@@ -20940,91 +21043,91 @@ perform the operation on all messages in that region.
;;;;;; 0))
;;; Generated autoloads from mh-e/mh-identity.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-identity" '("mh-")))
+(register-definition-prefixes "mh-identity" '("mh-"))
;;;***
;;;### (autoloads nil "mh-inc" "mh-e/mh-inc.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-inc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-inc" '("mh-inc-spool-")))
+(register-definition-prefixes "mh-inc" '("mh-inc-spool-"))
;;;***
;;;### (autoloads nil "mh-junk" "mh-e/mh-junk.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-junk.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-junk" '("mh-")))
+(register-definition-prefixes "mh-junk" '("mh-"))
;;;***
;;;### (autoloads nil "mh-letter" "mh-e/mh-letter.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-letter.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-letter" '("mh-")))
+(register-definition-prefixes "mh-letter" '("mh-"))
;;;***
;;;### (autoloads nil "mh-limit" "mh-e/mh-limit.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-limit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-limit" '("mh-")))
+(register-definition-prefixes "mh-limit" '("mh-"))
;;;***
;;;### (autoloads nil "mh-mime" "mh-e/mh-mime.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-mime.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-mime" '("mh-")))
+(register-definition-prefixes "mh-mime" '("mh-"))
;;;***
;;;### (autoloads nil "mh-print" "mh-e/mh-print.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-print.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-print" '("mh-p")))
+(register-definition-prefixes "mh-print" '("mh-p"))
;;;***
;;;### (autoloads nil "mh-scan" "mh-e/mh-scan.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-scan.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-scan" '("mh-")))
+(register-definition-prefixes "mh-scan" '("mh-"))
;;;***
;;;### (autoloads nil "mh-search" "mh-e/mh-search.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-search.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-search" '("mh-")))
+(register-definition-prefixes "mh-search" '("mh-"))
;;;***
;;;### (autoloads nil "mh-seq" "mh-e/mh-seq.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-seq.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-seq" '("mh-")))
+(register-definition-prefixes "mh-seq" '("mh-"))
;;;***
;;;### (autoloads nil "mh-show" "mh-e/mh-show.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-show.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-show" '("mh-")))
+(register-definition-prefixes "mh-show" '("mh-"))
;;;***
;;;### (autoloads nil "mh-speed" "mh-e/mh-speed.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-speed.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-speed" '("mh-")))
+(register-definition-prefixes "mh-speed" '("mh-"))
;;;***
;;;### (autoloads nil "mh-thread" "mh-e/mh-thread.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-thread.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-thread" '("mh-")))
+(register-definition-prefixes "mh-thread" '("mh-"))
;;;***
@@ -21032,21 +21135,21 @@ perform the operation on all messages in that region.
;;;;;; 0))
;;; Generated autoloads from mh-e/mh-tool-bar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-tool-bar" '("mh-tool-bar-")))
+(register-definition-prefixes "mh-tool-bar" '("mh-tool-bar-"))
;;;***
;;;### (autoloads nil "mh-utils" "mh-e/mh-utils.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-utils.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-utils" '("mh-")))
+(register-definition-prefixes "mh-utils" '("mh-"))
;;;***
;;;### (autoloads nil "mh-xface" "mh-e/mh-xface.el" (0 0 0 0))
;;; Generated autoloads from mh-e/mh-xface.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mh-xface" '("mh-")))
+(register-definition-prefixes "mh-xface" '("mh-"))
;;;***
@@ -21063,7 +21166,7 @@ the rules from `css-mode'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mhtml-mode" '("mhtml-")))
+(register-definition-prefixes "mhtml-mode" '("mhtml-"))
;;;***
@@ -21083,10 +21186,16 @@ or call the function `midnight-mode'.")
(autoload 'midnight-mode "midnight" "\
Non-nil means run `midnight-hook' at midnight.
-If called interactively, enable Midnight mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Midnight mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
@@ -21109,7 +21218,7 @@ to its second argument TM.
\(fn SYMB TM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "midnight" '("clean-buffer-list-" "midnight-")))
+(register-definition-prefixes "midnight" '("clean-buffer-list-" "midnight-"))
;;;***
@@ -21129,10 +21238,16 @@ or call the function `minibuffer-electric-default-mode'.")
(autoload 'minibuffer-electric-default-mode "minibuf-eldef" "\
Toggle Minibuffer Electric Default mode.
-If called interactively, enable Minibuffer-Electric-Default mode if
-ARG is positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and toggle
-it if ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Minibuffer-Electric-Default mode'.
+If the prefix argument is positive, enable the mode, and if it is zero
+or negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Minibuffer Electric Default mode is a global minor mode. When
enabled, minibuffer prompts that show a default value only show
@@ -21143,7 +21258,7 @@ is modified to remove the default indication.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "minibuf-eldef" '("minibuf")))
+(register-definition-prefixes "minibuf-eldef" '("minibuf"))
;;;***
@@ -21197,7 +21312,7 @@ upper atmosphere. These cause momentary pockets of higher-pressure
air to form, which act as lenses that deflect incoming cosmic rays,
focusing them to strike the drive platter and flip the desired bit.
You can type `M-x butterfly C-M-c' to run it. This is a permuted
-variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'." t nil)
+variation of `C-x M-c M-butterfly' from url `https://xkcd.com/378/'." t nil)
(autoload 'list-dynamic-libraries "misc" "\
Display a list of all dynamic libraries known to Emacs.
@@ -21210,7 +21325,7 @@ The return value is always nil.
\(fn &optional LOADED-ONLY-P BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "misc" '("list-dynamic-libraries--")))
+(register-definition-prefixes "misc" '("list-dynamic-libraries--"))
;;;***
@@ -21298,42 +21413,42 @@ whose file names match the specified wildcard.
\(fn FILES)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "misearch" '("misearch-unload-function" "multi-isearch-")))
+(register-definition-prefixes "misearch" '("misearch-unload-function" "multi-isearch-"))
;;;***
;;;### (autoloads nil "mixal-mode" "progmodes/mixal-mode.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from progmodes/mixal-mode.el
-(push (purecopy '(mixal-mode 0 1)) package--builtin-versions)
+(push (purecopy '(mixal-mode 0 4)) package--builtin-versions)
(autoload 'mixal-mode "mixal-mode" "\
Major mode for the mixal asm language.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mixal-mode" '("mixal-")))
+(register-definition-prefixes "mixal-mode" '("mixal-"))
;;;***
;;;### (autoloads nil "mm-archive" "gnus/mm-archive.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-archive.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-archive" '("mm-")))
+(register-definition-prefixes "mm-archive" '("mm-"))
;;;***
;;;### (autoloads nil "mm-bodies" "gnus/mm-bodies.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-bodies.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-bodies" '("mm-")))
+(register-definition-prefixes "mm-bodies" '("mm-"))
;;;***
;;;### (autoloads nil "mm-decode" "gnus/mm-decode.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-decode.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-decode" '("mm-")))
+(register-definition-prefixes "mm-decode" '("mm-"))
;;;***
@@ -21345,7 +21460,7 @@ Return a default encoding for FILE.
\(fn FILE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-encode" '("mm-")))
+(register-definition-prefixes "mm-encode" '("mm-"))
;;;***
@@ -21365,7 +21480,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing.
\(fn HANDLE &optional NO-DISPLAY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-extern" '("mm-extern-")))
+(register-definition-prefixes "mm-extern" '("mm-extern-"))
;;;***
@@ -21380,7 +21495,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing.
\(fn HANDLE &optional NO-DISPLAY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-partial" '("mm-partial-find-parts")))
+(register-definition-prefixes "mm-partial" '("mm-partial-find-parts"))
;;;***
@@ -21398,14 +21513,14 @@ Insert file contents of URL using `mm-url-program'.
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-url" '("mm-url-")))
+(register-definition-prefixes "mm-url" '("mm-url-"))
;;;***
;;;### (autoloads nil "mm-util" "gnus/mm-util.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-util" '("mm-")))
+(register-definition-prefixes "mm-util" '("mm-"))
;;;***
@@ -21426,14 +21541,14 @@ Assume text has been decoded if DECODED is non-nil.
\(fn HANDLE &optional DECODED)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-uu" '("mm-")))
+(register-definition-prefixes "mm-uu" '("mm-"))
;;;***
;;;### (autoloads nil "mm-view" "gnus/mm-view.el" (0 0 0 0))
;;; Generated autoloads from gnus/mm-view.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mm-view" '("mm-")))
+(register-definition-prefixes "mm-view" '("mm-"))
;;;***
@@ -21462,21 +21577,21 @@ will be computed and used.
\(fn FILE &optional TYPE DESCRIPTION DISPOSITION)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml" '("mime-to-mml" "mml-")))
+(register-definition-prefixes "mml" '("mime-to-mml" "mml-"))
;;;***
;;;### (autoloads nil "mml-sec" "gnus/mml-sec.el" (0 0 0 0))
;;; Generated autoloads from gnus/mml-sec.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml-sec" '("mml-")))
+(register-definition-prefixes "mml-sec" '("mml-"))
;;;***
;;;### (autoloads nil "mml-smime" "gnus/mml-smime.el" (0 0 0 0))
;;; Generated autoloads from gnus/mml-smime.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml-smime" '("mml-smime-")))
+(register-definition-prefixes "mml-smime" '("mml-smime-"))
;;;***
@@ -21493,7 +21608,7 @@ will be computed and used.
\(fn CONT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml1991" '("mml1991-")))
+(register-definition-prefixes "mml1991" '("mml1991-"))
;;;***
@@ -21532,7 +21647,7 @@ will be computed and used.
(autoload 'mml2015-self-encrypt "mml2015" nil nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mml2015" '("mml2015-")))
+(register-definition-prefixes "mml2015" '("mml2015-"))
;;;***
@@ -21541,7 +21656,7 @@ will be computed and used.
(put 'define-overloadable-function 'doc-string-elt 3)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mode-local" '("def" "describe-mode-local-bindings" "fetch-overload" "get-mode-local-parent" "make-obsolete-overload" "mode-local-" "setq-mode-local" "with-mode-local" "xref-mode-local-")))
+(register-definition-prefixes "mode-local" '("def" "describe-mode-local-bindings" "fetch-overload" "get-mode-local-parent" "make-obsolete-overload" "mode-local-" "setq-mode-local" "with-mode-local" "xref-mode-local-"))
;;;***
@@ -21576,7 +21691,7 @@ followed by the first character of the construct.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "modula2" '("m2-" "m3-font-lock-keywords")))
+(register-definition-prefixes "modula2" '("m2-" "m3-font-lock-keywords"))
;;;***
@@ -21603,14 +21718,14 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text.
\(fn BEG END)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "morse" '("morse-code" "nato-alphabet")))
+(register-definition-prefixes "morse" '("morse-code" "nato-alphabet"))
;;;***
;;;### (autoloads nil "mouse-copy" "mouse-copy.el" (0 0 0 0))
;;; Generated autoloads from mouse-copy.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mouse-copy" '("mouse-")))
+(register-definition-prefixes "mouse-copy" '("mouse-"))
;;;***
@@ -21659,7 +21774,7 @@ To test this function, evaluate:
\(fn START-EVENT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mouse-drag" '("mouse-")))
+(register-definition-prefixes "mouse-drag" '("mouse-"))
;;;***
@@ -21669,7 +21784,7 @@ To test this function, evaluate:
(autoload 'mpc "mpc" "\
Main entry point for MPC." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mpc" '("mpc-" "tag-browser-tagtypes")))
+(register-definition-prefixes "mpc" '("mpc-" "tag-browser-tagtypes"))
;;;***
@@ -21679,7 +21794,7 @@ Main entry point for MPC." t nil)
(autoload 'mpuz "mpuz" "\
Multiplication puzzle with GNU Emacs." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mpuz" '("mpuz-")))
+(register-definition-prefixes "mpuz" '("mpuz-"))
;;;***
@@ -21699,24 +21814,36 @@ or call the function `msb-mode'.")
(autoload 'msb-mode "msb" "\
Toggle Msb mode.
-If called interactively, enable Msb mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Msb mode'. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
different buffer menu using the function `msb'.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "msb" '("mouse-select-buffer" "msb")))
+(register-definition-prefixes "msb" '("mouse-select-buffer" "msb"))
;;;***
;;;### (autoloads nil "mspools" "mail/mspools.el" (0 0 0 0))
;;; Generated autoloads from mail/mspools.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mspools" '("mspools-")))
+(autoload 'mspools-show "mspools" "\
+Show the list of non-empty spool files in the *spools* buffer.
+Buffer is not displayed if SHOW is non-nil.
+
+\(fn &optional NOSHOW)" t nil)
+
+(register-definition-prefixes "mspools" '("mspools-"))
;;;***
@@ -21840,7 +21967,7 @@ The default is 20. If LIMIT is negative, do not limit the listing.
\(fn &optional LIMIT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mule-diag" '("charset-history" "describe-font-internal" "insert-section" "list-" "non-iso-charset-alist" "print-" "sort-listed-character-sets")))
+(register-definition-prefixes "mule-diag" '("charset-history" "describe-font-internal" "insert-section" "list-" "print-" "sort-listed-character-sets"))
;;;***
@@ -21875,7 +22002,7 @@ If ELLIPSIS is non-nil, it should be a string which will replace the
end of STR (including any padding) if it extends beyond END-COLUMN,
unless the display width of STR is equal to or less than the display
width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS
-defaults to `truncate-string-ellipsis'.
+defaults to `truncate-string-ellipsis', or to three dots when it's nil.
If ELLIPSIS-TEXT-PROPERTY is non-nil, a too-long string will not
be truncated, but instead the elided parts will be covered by a
@@ -21947,15 +22074,6 @@ operations such as `find-coding-systems-region'.
\(fn CODING-SYSTEMS &rest BODY)" nil t)
(put 'with-coding-priority 'lisp-indent-function 1)
-(autoload 'detect-coding-with-priority "mule-util" "\
-Detect a coding system of the text between FROM and TO with PRIORITY-LIST.
-PRIORITY-LIST is an alist of coding categories vs the corresponding
-coding systems ordered by priority.
-
-\(fn FROM TO PRIORITY-LIST)" nil t)
-
-(make-obsolete 'detect-coding-with-priority 'with-coding-priority '"23.1")
-
(autoload 'detect-coding-with-language-environment "mule-util" "\
Detect a coding system for the text between FROM and TO with LANG-ENV.
The detection takes into account the coding system priorities for the
@@ -21991,14 +22109,14 @@ QUALITY can be:
\(fn POSITION &optional QUALITY CODING-SYSTEM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mule-util" '("filepos-to-bufferpos--dos" "truncate-string-ellipsis")))
+(register-definition-prefixes "mule-util" '("filepos-to-bufferpos--dos" "truncate-string-ellipsis"))
;;;***
;;;### (autoloads nil "mwheel" "mwheel.el" (0 0 0 0))
;;; Generated autoloads from mwheel.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-")))
+(register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-"))
;;;***
@@ -22128,7 +22246,7 @@ Open a network connection to HOST on PORT.
\(fn HOST PORT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "net-utils" '("arp-program" "dig-program" "dns-lookup-program" "finger-X.500-host-regexps" "ftp-" "ifconfig-program" "ipconfig" "iwconfig-program" "net" "nslookup-" "ping-program" "route-program" "run-network-program" "smbclient" "traceroute-program" "whois-")))
+(register-definition-prefixes "net-utils" '("arp-program" "dig-program" "dns-lookup-program" "finger-X.500-host-regexps" "ftp-" "ifconfig-program" "ipconfig" "iwconfig-program" "net" "nslookup-" "ping-program" "route-program" "run-network-program" "smbclient" "traceroute-program" "whois-"))
;;;***
@@ -22142,7 +22260,7 @@ listed in the PORTS list.
\(fn MACHINE &rest PORTS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "netrc" '("netrc-")))
+(register-definition-prefixes "netrc" '("netrc-"))
;;;***
@@ -22186,6 +22304,10 @@ values:
`ssl' -- Equivalent to `tls'.
`shell' -- A shell connection.
+:coding is a symbol or a cons used to specify the coding systems
+used to decode and encode the data which the process reads and
+writes. See `make-network-process' for details.
+
:return-list specifies this function's return value.
If omitted or nil, return a process object. A non-nil means to
return (PROC . PROPS), where PROC is a process object and PROPS
@@ -22208,7 +22330,10 @@ values:
:capability-command specifies a command used to query the HOST
for its capabilities. For instance, for IMAP this should be
- \"1 CAPABILITY\\r\\n\".
+ \"1 CAPABILITY\\r\\n\". This can either be a string (which will
+ then be sent verbatim to the server), or a function (called with
+ a single parameter; the \"greeting\" from the server when connecting),
+ and should return a string to send to the server.
:starttls-function specifies a function for handling STARTTLS.
This function should take one parameter, the response to the
@@ -22239,8 +22364,8 @@ a greeting from the server.
:nowait, if non-nil, says the connection should be made
asynchronously, if possible.
-:shell-command is a format-spec string that can be used if :type
-is `shell'. It has two specs, %s for host and %p for port
+:shell-command is a `format-spec' string that can be used if
+:type is `shell'. It has two specs, %s for host and %p for port
number. Example: \"ssh gateway nc %s %p\".
:tls-parameters is a list that should be supplied if you're
@@ -22253,7 +22378,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters').
(defalias 'open-protocol-stream 'open-network-stream)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "network-stream" '("network-stream-")))
+(register-definition-prefixes "network-stream" '("network-stream-"))
;;;***
@@ -22275,7 +22400,7 @@ Run `newsticker-start-hook' if newsticker was not running already.
\(fn &optional DO-NOT-COMPLAIN-IF-RUNNING)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-backend" '("newsticker-")))
+(register-definition-prefixes "newst-backend" '("newsticker-"))
;;;***
@@ -22286,7 +22411,7 @@ Run `newsticker-start-hook' if newsticker was not running already.
(autoload 'newsticker-plainview "newst-plainview" "\
Start newsticker plainview." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-plainview" '("newsticker-")))
+(register-definition-prefixes "newst-plainview" '("newsticker-"))
;;;***
@@ -22297,7 +22422,7 @@ Start newsticker plainview." t nil)
(autoload 'newsticker-show-news "newst-reader" "\
Start reading news. You may want to bind this to a key." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-reader" '("newsticker-")))
+(register-definition-prefixes "newst-reader" '("newsticker-"))
;;;***
@@ -22316,7 +22441,7 @@ Start newsticker's ticker (but not the news retrieval).
Start display timer for the actual ticker if wanted and not
running already." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-ticker" '("newsticker-")))
+(register-definition-prefixes "newst-ticker" '("newsticker-"))
;;;***
@@ -22327,28 +22452,28 @@ running already." t nil)
(autoload 'newsticker-treeview "newst-treeview" "\
Start newsticker treeview." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newst-treeview" '("newsticker-")))
+(register-definition-prefixes "newst-treeview" '("newsticker-"))
;;;***
;;;### (autoloads nil "newsticker" "net/newsticker.el" (0 0 0 0))
;;; Generated autoloads from net/newsticker.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "newsticker" '("newsticker-version")))
+(register-definition-prefixes "newsticker" '("newsticker-version"))
;;;***
;;;### (autoloads nil "nnagent" "gnus/nnagent.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnagent.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnagent" '("nnagent-")))
+(register-definition-prefixes "nnagent" '("nnagent-"))
;;;***
;;;### (autoloads nil "nnbabyl" "gnus/nnbabyl.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnbabyl.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnbabyl" '("nnbabyl-")))
+(register-definition-prefixes "nnbabyl" '("nnbabyl-"))
;;;***
@@ -22360,14 +22485,14 @@ Generate NOV databases in all nndiary directories.
\(fn &optional SERVER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndiary" '("nndiary-")))
+(register-definition-prefixes "nndiary" '("nndiary-"))
;;;***
;;;### (autoloads nil "nndir" "gnus/nndir.el" (0 0 0 0))
;;; Generated autoloads from gnus/nndir.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndir" '("nndir-")))
+(register-definition-prefixes "nndir" '("nndir-"))
;;;***
@@ -22383,21 +22508,21 @@ symbol in the alist.
\(fn DEFINITION &optional POSITION)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndoc" '("nndoc-")))
+(register-definition-prefixes "nndoc" '("nndoc-"))
;;;***
;;;### (autoloads nil "nndraft" "gnus/nndraft.el" (0 0 0 0))
;;; Generated autoloads from gnus/nndraft.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nndraft" '("nndraft-")))
+(register-definition-prefixes "nndraft" '("nndraft-"))
;;;***
;;;### (autoloads nil "nneething" "gnus/nneething.el" (0 0 0 0))
;;; Generated autoloads from gnus/nneething.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nneething" '("nneething-")))
+(register-definition-prefixes "nneething" '("nneething-"))
;;;***
@@ -22408,70 +22533,70 @@ symbol in the alist.
Look for mbox folders in the nnfolder directory and make them into groups.
This command does not work if you use short group names." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnfolder" '("nnfolder-")))
+(register-definition-prefixes "nnfolder" '("nnfolder-"))
;;;***
;;;### (autoloads nil "nngateway" "gnus/nngateway.el" (0 0 0 0))
;;; Generated autoloads from gnus/nngateway.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nngateway" '("nngateway-")))
+(register-definition-prefixes "nngateway" '("nngateway-"))
;;;***
;;;### (autoloads nil "nnheader" "gnus/nnheader.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnheader.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnheader" '("gnus-" "mail-header-" "make-mail-header" "nnheader-" "nntp-")))
+(register-definition-prefixes "nnheader" '("gnus-" "mail-header-" "make-mail-header" "nnheader-" "nntp-"))
;;;***
;;;### (autoloads nil "nnimap" "gnus/nnimap.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnimap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnimap" '("nnimap-")))
+(register-definition-prefixes "nnimap" '("nnimap-"))
;;;***
;;;### (autoloads nil "nnir" "gnus/nnir.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnir.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnir" '("gnus-" "nnir-")))
+(register-definition-prefixes "nnir" '("nnir-"))
;;;***
;;;### (autoloads nil "nnmail" "gnus/nnmail.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmail.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmail" '("nnmail-")))
+(register-definition-prefixes "nnmail" '("nnmail-"))
;;;***
;;;### (autoloads nil "nnmaildir" "gnus/nnmaildir.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmaildir.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmaildir" '("nnmaildir-")))
+(register-definition-prefixes "nnmaildir" '("nnmaildir-"))
;;;***
;;;### (autoloads nil "nnmairix" "gnus/nnmairix.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmairix.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmairix" '("nnmairix-")))
+(register-definition-prefixes "nnmairix" '("nnmairix-"))
;;;***
;;;### (autoloads nil "nnmbox" "gnus/nnmbox.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmbox.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmbox" '("nnmbox-")))
+(register-definition-prefixes "nnmbox" '("nnmbox-"))
;;;***
;;;### (autoloads nil "nnmh" "gnus/nnmh.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnmh.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnmh" '("nnmh-")))
+(register-definition-prefixes "nnmh" '("nnmh-"))
;;;***
@@ -22483,70 +22608,77 @@ Generate NOV databases in all nnml directories.
\(fn &optional SERVER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnml" '("nnml-")))
+(register-definition-prefixes "nnml" '("nnml-"))
;;;***
;;;### (autoloads nil "nnnil" "gnus/nnnil.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnnil.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnnil" '("nnnil-")))
+(register-definition-prefixes "nnnil" '("nnnil-"))
;;;***
;;;### (autoloads nil "nnoo" "gnus/nnoo.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnoo.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnoo" '("deffoo" "defvoo" "nnoo-")))
+(register-definition-prefixes "nnoo" '("deffoo" "defvoo" "nnoo-"))
;;;***
;;;### (autoloads nil "nnregistry" "gnus/nnregistry.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnregistry.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnregistry" '("nnregistry-")))
+(register-definition-prefixes "nnregistry" '("nnregistry-"))
;;;***
;;;### (autoloads nil "nnrss" "gnus/nnrss.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnrss.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnrss" '("nnrss-")))
+(register-definition-prefixes "nnrss" '("nnrss-"))
+
+;;;***
+
+;;;### (autoloads nil "nnselect" "gnus/nnselect.el" (0 0 0 0))
+;;; Generated autoloads from gnus/nnselect.el
+
+(register-definition-prefixes "nnselect" '("gnus-" "ids-by-group" "nnselect-" "numbers-by-group"))
;;;***
;;;### (autoloads nil "nnspool" "gnus/nnspool.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnspool.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnspool" '("news-inews-program" "nnspool-")))
+(register-definition-prefixes "nnspool" '("news-inews-program" "nnspool-"))
;;;***
;;;### (autoloads nil "nntp" "gnus/nntp.el" (0 0 0 0))
;;; Generated autoloads from gnus/nntp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nntp" '("nntp-")))
+(register-definition-prefixes "nntp" '("nntp-"))
;;;***
;;;### (autoloads nil "nnvirtual" "gnus/nnvirtual.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnvirtual.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnvirtual" '("nnvirtual-")))
+(register-definition-prefixes "nnvirtual" '("nnvirtual-"))
;;;***
;;;### (autoloads nil "nnweb" "gnus/nnweb.el" (0 0 0 0))
;;; Generated autoloads from gnus/nnweb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nnweb" '("nnweb-")))
+(register-definition-prefixes "nnweb" '("nnweb-"))
;;;***
;;;### (autoloads nil "notifications" "notifications.el" (0 0 0 0))
;;; Generated autoloads from notifications.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "notifications" '("notifications-")))
+(register-definition-prefixes "notifications" '("notifications-"))
;;;***
@@ -22578,7 +22710,7 @@ future sessions.
\(fn COMMAND)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "novice" '("en/disable-command")))
+(register-definition-prefixes "novice" '("en/disable-command"))
;;;***
@@ -22595,14 +22727,14 @@ closing requests for requests that are used in matched pairs.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nroff-mode" '("nroff-")))
+(register-definition-prefixes "nroff-mode" '("nroff-"))
;;;***
;;;### (autoloads nil "nsm" "net/nsm.el" (0 0 0 0))
;;; Generated autoloads from net/nsm.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nsm" '("network-security-" "nsm-")))
+(register-definition-prefixes "nsm" '("network-security-" "nsm-"))
;;;***
@@ -22610,21 +22742,21 @@ closing requests for requests that are used in matched pairs.
;;; Generated autoloads from net/ntlm.el
(push (purecopy '(ntlm 2 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ntlm" '("ntlm-")))
+(register-definition-prefixes "ntlm" '("ntlm-"))
;;;***
;;;### (autoloads nil "nxml-enc" "nxml/nxml-enc.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-enc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-enc" '("nxml-")))
+(register-definition-prefixes "nxml-enc" '("nxml-"))
;;;***
;;;### (autoloads nil "nxml-maint" "nxml/nxml-maint.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-maint.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-maint" '("nxml-insert-target-repertoire-glyph-set")))
+(register-definition-prefixes "nxml-maint" '("nxml-insert-target-repertoire-glyph-set"))
;;;***
@@ -22685,63 +22817,63 @@ Many aspects this mode can be customized using
\(fn)" t nil)
(defalias 'xml-mode 'nxml-mode)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-mode" '("nxml-")))
+(register-definition-prefixes "nxml-mode" '("nxml-"))
;;;***
;;;### (autoloads nil "nxml-ns" "nxml/nxml-ns.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-ns.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-ns" '("nxml-ns-")))
+(register-definition-prefixes "nxml-ns" '("nxml-ns-"))
;;;***
;;;### (autoloads nil "nxml-outln" "nxml/nxml-outln.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-outln.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-outln" '("nxml-")))
+(register-definition-prefixes "nxml-outln" '("nxml-"))
;;;***
;;;### (autoloads nil "nxml-parse" "nxml/nxml-parse.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-parse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-parse" '("nxml-")))
+(register-definition-prefixes "nxml-parse" '("nxml-"))
;;;***
;;;### (autoloads nil "nxml-rap" "nxml/nxml-rap.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-rap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-rap" '("nxml-")))
+(register-definition-prefixes "nxml-rap" '("nxml-"))
;;;***
;;;### (autoloads nil "nxml-util" "nxml/nxml-util.el" (0 0 0 0))
;;; Generated autoloads from nxml/nxml-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nxml-util" '("nxml-")))
+(register-definition-prefixes "nxml-util" '("nxml-"))
;;;***
;;;### (autoloads nil "ob-C" "org/ob-C.el" (0 0 0 0))
;;; Generated autoloads from org/ob-C.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-C" '("org-babel-")))
+(register-definition-prefixes "ob-C" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-J" "org/ob-J.el" (0 0 0 0))
;;; Generated autoloads from org/ob-J.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-J" '("obj-" "org-babel-")))
+(register-definition-prefixes "ob-J" '("obj-" "org-babel-"))
;;;***
;;;### (autoloads nil "ob-R" "org/ob-R.el" (0 0 0 0))
;;; Generated autoloads from org/ob-R.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-R" '("ob-R-" "org-babel-")))
+(register-definition-prefixes "ob-R" '("ob-R-" "org-babel-"))
;;;***
@@ -22749,7 +22881,7 @@ Many aspects this mode can be customized using
;;; Generated autoloads from org/ob-abc.el
(push (purecopy '(ob-abc 0 1)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-abc" '("org-babel-")))
+(register-definition-prefixes "ob-abc" '("org-babel-"))
;;;***
@@ -22757,71 +22889,63 @@ Many aspects this mode can be customized using
;;;;;; 0))
;;; Generated autoloads from org/ob-asymptote.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-asymptote" '("org-babel-")))
+(register-definition-prefixes "ob-asymptote" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-awk" "org/ob-awk.el" (0 0 0 0))
;;; Generated autoloads from org/ob-awk.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-awk" '("org-babel-")))
+(register-definition-prefixes "ob-awk" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-calc" "org/ob-calc.el" (0 0 0 0))
;;; Generated autoloads from org/ob-calc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-calc" '("org-babel-")))
+(register-definition-prefixes "ob-calc" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-clojure" "org/ob-clojure.el" (0 0 0 0))
;;; Generated autoloads from org/ob-clojure.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-clojure" '("org-babel-")))
+(register-definition-prefixes "ob-clojure" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-comint" "org/ob-comint.el" (0 0 0 0))
;;; Generated autoloads from org/ob-comint.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-comint" '("org-babel-comint-")))
+(register-definition-prefixes "ob-comint" '("org-babel-comint-"))
;;;***
;;;### (autoloads nil "ob-coq" "org/ob-coq.el" (0 0 0 0))
;;; Generated autoloads from org/ob-coq.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-coq" '("coq-program-name" "org-babel-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ob-core" "org/ob-core.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ob-core.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-core" '("org-")))
+(register-definition-prefixes "ob-coq" '("coq-program-name" "org-babel-"))
;;;***
;;;### (autoloads nil "ob-css" "org/ob-css.el" (0 0 0 0))
;;; Generated autoloads from org/ob-css.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-css" '("org-babel-")))
+(register-definition-prefixes "ob-css" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-ditaa" "org/ob-ditaa.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ditaa.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ditaa" '("org-")))
+(register-definition-prefixes "ob-ditaa" '("org-"))
;;;***
;;;### (autoloads nil "ob-dot" "org/ob-dot.el" (0 0 0 0))
;;; Generated autoloads from org/ob-dot.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-dot" '("org-babel-")))
+(register-definition-prefixes "ob-dot" '("org-babel-"))
;;;***
@@ -22829,7 +22953,7 @@ Many aspects this mode can be customized using
;;; Generated autoloads from org/ob-ebnf.el
(push (purecopy '(ob-ebnf 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ebnf" '("org-babel-")))
+(register-definition-prefixes "ob-ebnf" '("org-babel-"))
;;;***
@@ -22837,197 +22961,189 @@ Many aspects this mode can be customized using
;;;;;; 0 0))
;;; Generated autoloads from org/ob-emacs-lisp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-emacs-lisp" '("org-babel-")))
+(register-definition-prefixes "ob-emacs-lisp" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-eshell" "org/ob-eshell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-eshell.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-eshell" '("ob-eshell-session-live-p" "org-babel-")))
+(register-definition-prefixes "ob-eshell" '("ob-eshell-session-live-p" "org-babel-"))
;;;***
;;;### (autoloads nil "ob-eval" "org/ob-eval.el" (0 0 0 0))
;;; Generated autoloads from org/ob-eval.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-eval" '("org-babel-")))
+(register-definition-prefixes "ob-eval" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-exp" "org/ob-exp.el" (0 0 0 0))
;;; Generated autoloads from org/ob-exp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-exp" '("org-")))
+(register-definition-prefixes "ob-exp" '("org-"))
;;;***
;;;### (autoloads nil "ob-forth" "org/ob-forth.el" (0 0 0 0))
;;; Generated autoloads from org/ob-forth.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-forth" '("org-babel-")))
+(register-definition-prefixes "ob-forth" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-fortran" "org/ob-fortran.el" (0 0 0 0))
;;; Generated autoloads from org/ob-fortran.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-fortran" '("org-babel-")))
+(register-definition-prefixes "ob-fortran" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-gnuplot" "org/ob-gnuplot.el" (0 0 0 0))
;;; Generated autoloads from org/ob-gnuplot.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-gnuplot" '("*org-babel-gnuplot-" "org-babel-")))
+(register-definition-prefixes "ob-gnuplot" '("*org-babel-gnuplot-" "org-babel-"))
;;;***
;;;### (autoloads nil "ob-groovy" "org/ob-groovy.el" (0 0 0 0))
;;; Generated autoloads from org/ob-groovy.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-groovy" '("org-babel-")))
+(register-definition-prefixes "ob-groovy" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-haskell" "org/ob-haskell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-haskell.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-haskell" '("org-babel-")))
+(register-definition-prefixes "ob-haskell" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-hledger" "org/ob-hledger.el" (0 0 0 0))
;;; Generated autoloads from org/ob-hledger.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-hledger" '("org-babel-")))
+(register-definition-prefixes "ob-hledger" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-io" "org/ob-io.el" (0 0 0 0))
;;; Generated autoloads from org/ob-io.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-io" '("org-babel-")))
+(register-definition-prefixes "ob-io" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-java" "org/ob-java.el" (0 0 0 0))
;;; Generated autoloads from org/ob-java.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-java" '("org-babel-")))
+(register-definition-prefixes "ob-java" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-js" "org/ob-js.el" (0 0 0 0))
;;; Generated autoloads from org/ob-js.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-js" '("org-babel-")))
+(register-definition-prefixes "ob-js" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-latex" "org/ob-latex.el" (0 0 0 0))
;;; Generated autoloads from org/ob-latex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-latex" '("org-babel-")))
+(register-definition-prefixes "ob-latex" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-ledger" "org/ob-ledger.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ledger.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ledger" '("org-babel-")))
+(register-definition-prefixes "ob-ledger" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-lilypond" "org/ob-lilypond.el" (0 0 0 0))
;;; Generated autoloads from org/ob-lilypond.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lilypond" '("lilypond-mode" "org-babel-")))
+(register-definition-prefixes "ob-lilypond" '("lilypond-mode" "org-babel-"))
;;;***
;;;### (autoloads nil "ob-lisp" "org/ob-lisp.el" (0 0 0 0))
;;; Generated autoloads from org/ob-lisp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lisp" '("org-babel-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ob-lob" "org/ob-lob.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ob-lob.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lob" '("org-babel-")))
+(register-definition-prefixes "ob-lisp" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-lua" "org/ob-lua.el" (0 0 0 0))
;;; Generated autoloads from org/ob-lua.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lua" '("org-babel-")))
+(register-definition-prefixes "ob-lua" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-makefile" "org/ob-makefile.el" (0 0 0 0))
;;; Generated autoloads from org/ob-makefile.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-makefile" '("org-babel-")))
+(register-definition-prefixes "ob-makefile" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-maxima" "org/ob-maxima.el" (0 0 0 0))
;;; Generated autoloads from org/ob-maxima.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-maxima" '("org-babel-")))
+(register-definition-prefixes "ob-maxima" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-mscgen" "org/ob-mscgen.el" (0 0 0 0))
;;; Generated autoloads from org/ob-mscgen.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-mscgen" '("org-babel-")))
+(register-definition-prefixes "ob-mscgen" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-ocaml" "org/ob-ocaml.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ocaml.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ocaml" '("org-babel-")))
+(register-definition-prefixes "ob-ocaml" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-octave" "org/ob-octave.el" (0 0 0 0))
;;; Generated autoloads from org/ob-octave.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-octave" '("org-babel-")))
+(register-definition-prefixes "ob-octave" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-org" "org/ob-org.el" (0 0 0 0))
;;; Generated autoloads from org/ob-org.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-org" '("org-babel-")))
+(register-definition-prefixes "ob-org" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-perl" "org/ob-perl.el" (0 0 0 0))
;;; Generated autoloads from org/ob-perl.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-perl" '("org-babel-")))
+(register-definition-prefixes "ob-perl" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-picolisp" "org/ob-picolisp.el" (0 0 0 0))
;;; Generated autoloads from org/ob-picolisp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-picolisp" '("org-babel-")))
+(register-definition-prefixes "ob-picolisp" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-plantuml" "org/ob-plantuml.el" (0 0 0 0))
;;; Generated autoloads from org/ob-plantuml.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-plantuml" '("org-")))
+(register-definition-prefixes "ob-plantuml" '("org-"))
;;;***
@@ -23035,49 +23151,49 @@ Many aspects this mode can be customized using
;;;;;; 0 0))
;;; Generated autoloads from org/ob-processing.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-processing" '("org-babel-")))
+(register-definition-prefixes "ob-processing" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-python" "org/ob-python.el" (0 0 0 0))
;;; Generated autoloads from org/ob-python.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-python" '("org-babel-")))
+(register-definition-prefixes "ob-python" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-ref" "org/ob-ref.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ref.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ref" '("org-babel-")))
+(register-definition-prefixes "ob-ref" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-ruby" "org/ob-ruby.el" (0 0 0 0))
;;; Generated autoloads from org/ob-ruby.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ruby" '("org-babel-")))
+(register-definition-prefixes "ob-ruby" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-sass" "org/ob-sass.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sass.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sass" '("org-babel-")))
+(register-definition-prefixes "ob-sass" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-scheme" "org/ob-scheme.el" (0 0 0 0))
;;; Generated autoloads from org/ob-scheme.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-scheme" '("org-babel-")))
+(register-definition-prefixes "ob-scheme" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-screen" "org/ob-screen.el" (0 0 0 0))
;;; Generated autoloads from org/ob-screen.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-screen" '("org-babel-")))
+(register-definition-prefixes "ob-screen" '("org-babel-"))
;;;***
@@ -23085,64 +23201,56 @@ Many aspects this mode can be customized using
;;; Generated autoloads from org/ob-sed.el
(push (purecopy '(ob-sed 0 1 1)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sed" '("org-babel-")))
+(register-definition-prefixes "ob-sed" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-shell" "org/ob-shell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-shell.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shell" '("org-babel-")))
+(register-definition-prefixes "ob-shell" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-shen" "org/ob-shen.el" (0 0 0 0))
;;; Generated autoloads from org/ob-shen.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shen" '("org-babel-")))
+(register-definition-prefixes "ob-shen" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-sql" "org/ob-sql.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sql.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sql" '("org-babel-")))
+(register-definition-prefixes "ob-sql" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-sqlite" "org/ob-sqlite.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sqlite.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sqlite" '("org-babel-")))
+(register-definition-prefixes "ob-sqlite" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-stan" "org/ob-stan.el" (0 0 0 0))
;;; Generated autoloads from org/ob-stan.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-stan" '("org-babel-")))
+(register-definition-prefixes "ob-stan" '("org-babel-"))
;;;***
;;;### (autoloads nil "ob-table" "org/ob-table.el" (0 0 0 0))
;;; Generated autoloads from org/ob-table.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-table" '("org-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ob-tangle" "org/ob-tangle.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ob-tangle.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-tangle" '("org-babel-")))
+(register-definition-prefixes "ob-table" '("org-"))
;;;***
;;;### (autoloads nil "ob-vala" "org/ob-vala.el" (0 0 0 0))
;;; Generated autoloads from org/ob-vala.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-vala" '("org-babel-")))
+(register-definition-prefixes "ob-vala" '("org-babel-"))
;;;***
@@ -23185,14 +23293,14 @@ startup file, `~/.emacs-octave'.
(defalias 'run-octave 'inferior-octave)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "octave" '("inferior-octave-" "octave-")))
+(register-definition-prefixes "octave" '("inferior-octave-" "octave-"))
;;;***
;;;### (autoloads nil "ogonek" "international/ogonek.el" (0 0 0 0))
;;; Generated autoloads from international/ogonek.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ogonek" '("ogonek-")))
+(register-definition-prefixes "ogonek" '("ogonek-"))
;;;***
@@ -23296,86 +23404,70 @@ This command can be called in any mode to insert a link in Org syntax." t nil)
Find all radio targets in this file and update the regular expression.
Also refresh fontification if needed." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol" '("org-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ol-bbdb" "org/ol-bbdb.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ol-bbdb.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-bbdb" '("org-bbdb-")))
+(register-definition-prefixes "ol" '("org-"))
;;;***
;;;### (autoloads nil "ol-bibtex" "org/ol-bibtex.el" (0 0 0 0))
;;; Generated autoloads from org/ol-bibtex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-bibtex" '("org-")))
+(register-definition-prefixes "ol-bibtex" '("org-"))
;;;***
;;;### (autoloads nil "ol-docview" "org/ol-docview.el" (0 0 0 0))
;;; Generated autoloads from org/ol-docview.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-docview" '("org-docview-")))
+(register-definition-prefixes "ol-docview" '("org-docview-"))
;;;***
;;;### (autoloads nil "ol-eshell" "org/ol-eshell.el" (0 0 0 0))
;;; Generated autoloads from org/ol-eshell.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-eshell" '("org-eshell-")))
+(register-definition-prefixes "ol-eshell" '("org-eshell-"))
;;;***
;;;### (autoloads nil "ol-eww" "org/ol-eww.el" (0 0 0 0))
;;; Generated autoloads from org/ol-eww.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-eww" '("org-eww-")))
+(register-definition-prefixes "ol-eww" '("org-eww-"))
;;;***
;;;### (autoloads nil "ol-gnus" "org/ol-gnus.el" (0 0 0 0))
;;; Generated autoloads from org/ol-gnus.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-gnus" '("org-gnus-")))
+(register-definition-prefixes "ol-gnus" '("org-gnus-"))
;;;***
;;;### (autoloads nil "ol-info" "org/ol-info.el" (0 0 0 0))
;;; Generated autoloads from org/ol-info.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-info" '("org-info-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ol-irc" "org/ol-irc.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ol-irc.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-irc" '("org-irc-")))
+(register-definition-prefixes "ol-info" '("org-info-"))
;;;***
;;;### (autoloads nil "ol-mhe" "org/ol-mhe.el" (0 0 0 0))
;;; Generated autoloads from org/ol-mhe.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-mhe" '("org-mhe-")))
+(register-definition-prefixes "ol-mhe" '("org-mhe-"))
;;;***
;;;### (autoloads nil "ol-rmail" "org/ol-rmail.el" (0 0 0 0))
;;; Generated autoloads from org/ol-rmail.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-rmail" '("org-rmail-")))
+(register-definition-prefixes "ol-rmail" '("org-rmail-"))
;;;***
;;;### (autoloads nil "ol-w3m" "org/ol-w3m.el" (0 0 0 0))
;;; Generated autoloads from org/ol-w3m.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ol-w3m" '("org-w3m-")))
+(register-definition-prefixes "ol-w3m" '("org-w3m-"))
;;;***
@@ -23412,7 +23504,7 @@ Coloring:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "opascal" '("opascal-")))
+(register-definition-prefixes "opascal" '("opascal-"))
;;;***
@@ -23607,7 +23699,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions.
(autoload 'org-customize "org" "\
Call the customize function with org as argument." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org" '("org-" "turn-on-org-cdlatex")))
+(register-definition-prefixes "org" '("org-" "turn-on-org-cdlatex"))
;;;***
@@ -23883,23 +23975,7 @@ to override `appt-message-warning-time'.
\(fn &optional REFRESH FILTER &rest ARGS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-agenda" '("org-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-archive"
-;;;;;; "org/org-archive.el" (0 0 0 0))
-;;; Generated autoloads from org/org-archive.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-archive" '("org-a")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-attach" "org/org-attach.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/org-attach.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-attach" '("org-attach-")))
+(register-definition-prefixes "org-agenda" '("org-"))
;;;***
@@ -23907,7 +23983,7 @@ to override `appt-message-warning-time'.
;;;;;; 0 0 0))
;;; Generated autoloads from org/org-attach-git.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-attach-git" '("org-attach-git-")))
+(register-definition-prefixes "org-attach-git" '("org-attach-git-"))
;;;***
@@ -23953,15 +24029,7 @@ of the day at point (if any) or the current HH:MM time.
(autoload 'org-capture-import-remember-templates "org-capture" "\
Set `org-capture-templates' to be similar to `org-remember-templates'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-capture" '("org-capture-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-clock" "org/org-clock.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/org-clock.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-clock" '("org-")))
+(register-definition-prefixes "org-capture" '("org-capture-"))
;;;***
@@ -24052,7 +24120,7 @@ Create a dynamic block capturing a column view table." t nil)
(autoload 'org-agenda-columns "org-colview" "\
Turn on or update column view in the agenda." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-colview" '("org-")))
+(register-definition-prefixes "org-colview" '("org-"))
;;;***
@@ -24062,29 +24130,21 @@ Turn on or update column view in the agenda." t nil)
(autoload 'org-check-version "org-compat" "\
Try very hard to provide sensible version strings." nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-compat" '("org-")))
+(register-definition-prefixes "org-compat" '("org-"))
;;;***
;;;### (autoloads nil "org-crypt" "org/org-crypt.el" (0 0 0 0))
;;; Generated autoloads from org/org-crypt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-crypt" '("org-")))
+(register-definition-prefixes "org-crypt" '("org-"))
;;;***
;;;### (autoloads nil "org-ctags" "org/org-ctags.el" (0 0 0 0))
;;; Generated autoloads from org/org-ctags.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-ctags" '("org-ctags-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-datetree"
-;;;;;; "org/org-datetree.el" (0 0 0 0))
-;;; Generated autoloads from org/org-datetree.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-datetree" '("org-datetree-")))
+(register-definition-prefixes "org-ctags" '("org-ctags-"))
;;;***
@@ -24139,15 +24199,7 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
\(fn TIMES)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-duration" '("org-duration-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-element"
-;;;;;; "org/org-element.el" (0 0 0 0))
-;;; Generated autoloads from org/org-element.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-element" '("org-element-")))
+(register-definition-prefixes "org-duration" '("org-duration-"))
;;;***
@@ -24155,30 +24207,14 @@ with \"H:MM:SS\" format, return `h:mm:ss'. Otherwise, return
;;;;;; 0))
;;; Generated autoloads from org/org-entities.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-entities" '("org-entit")))
+(register-definition-prefixes "org-entities" '("org-entit"))
;;;***
;;;### (autoloads nil "org-faces" "org/org-faces.el" (0 0 0 0))
;;; Generated autoloads from org/org-faces.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-faces" '("org-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-feed" "org/org-feed.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/org-feed.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-feed" '("org-feed-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-footnote"
-;;;;;; "org/org-footnote.el" (0 0 0 0))
-;;; Generated autoloads from org/org-footnote.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-footnote" '("org-footnote-")))
+(register-definition-prefixes "org-faces" '("org-"))
;;;***
@@ -24214,30 +24250,14 @@ With a prefix argument, use the alternative interface: e.g., if
\(fn &optional ALTERNATIVE-INTERFACE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-goto" '("org-goto-")))
+(register-definition-prefixes "org-goto" '("org-goto-"))
;;;***
;;;### (autoloads nil "org-habit" "org/org-habit.el" (0 0 0 0))
;;; Generated autoloads from org/org-habit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-habit" '("org-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-id" "org/org-id.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/org-id.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-id" '("org-id-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-indent" "org/org-indent.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/org-indent.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-indent" '("org-")))
+(register-definition-prefixes "org-habit" '("org-"))
;;;***
@@ -24245,7 +24265,7 @@ With a prefix argument, use the alternative interface: e.g., if
;;;;;; 0 0 0))
;;; Generated autoloads from org/org-inlinetask.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-inlinetask" '("org-inlinetask-")))
+(register-definition-prefixes "org-inlinetask" '("org-inlinetask-"))
;;;***
@@ -24255,7 +24275,7 @@ With a prefix argument, use the alternative interface: e.g., if
(autoload 'org-babel-describe-bindings "org-keys" "\
Describe all keybindings behind `org-babel-key-prefix'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-keys" '("org-")))
+(register-definition-prefixes "org-keys" '("org-"))
;;;***
@@ -24273,21 +24293,21 @@ ARG can also be a list of checker names, as symbols, to run.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-lint" '("org-lint-")))
+(register-definition-prefixes "org-lint" '("org-lint-"))
;;;***
;;;### (autoloads nil "org-list" "org/org-list.el" (0 0 0 0))
;;; Generated autoloads from org/org-list.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-list" '("org-")))
+(register-definition-prefixes "org-list" '("org-"))
;;;***
;;;### (autoloads nil "org-macro" "org/org-macro.el" (0 0 0 0))
;;; Generated autoloads from org/org-macro.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-macro" '("org-macro-")))
+(register-definition-prefixes "org-macro" '("org-macro-"))
;;;***
@@ -24299,22 +24319,14 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX.
\(fn FILE)" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-macs" '("org-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-mobile" "org/org-mobile.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/org-mobile.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mobile" '("org-mobile-")))
+(register-definition-prefixes "org-macs" '("org-"))
;;;***
;;;### (autoloads nil "org-mouse" "org/org-mouse.el" (0 0 0 0))
;;; Generated autoloads from org/org-mouse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-mouse" '("org-mouse-")))
+(register-definition-prefixes "org-mouse" '("org-mouse-"))
;;;***
@@ -24330,14 +24342,20 @@ NUMBERING is a list of numbers.
(autoload 'org-num-mode "org-num" "\
Dynamic numbering of headlines in an Org buffer.
-If called interactively, enable Org-Num mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Org-Num mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-num" '("org-num-")))
+(register-definition-prefixes "org-num" '("org-num-"))
;;;***
@@ -24345,15 +24363,7 @@ enable the mode if ARG is omitted or nil, and toggle it if ARG is
;;;;;; 0 0))
;;; Generated autoloads from org/org-pcomplete.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-pcomplete" '("org-" "pcomplete/org-mode/")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-plot" "org/org-plot.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/org-plot.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-plot" '("org-plot")))
+(register-definition-prefixes "org-pcomplete" '("org-" "pcomplete/org-mode/"))
;;;***
@@ -24361,37 +24371,21 @@ enable the mode if ARG is omitted or nil, and toggle it if ARG is
;;;;;; 0))
;;; Generated autoloads from org/org-protocol.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-protocol" '("org-protocol-")))
+(register-definition-prefixes "org-protocol" '("org-protocol-"))
;;;***
;;;### (autoloads nil "org-src" "org/org-src.el" (0 0 0 0))
;;; Generated autoloads from org/org-src.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-src" '("org-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-table" "org/org-table.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/org-table.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-table" '("org")))
+(register-definition-prefixes "org-src" '("org-"))
;;;***
;;;### (autoloads nil "org-tempo" "org/org-tempo.el" (0 0 0 0))
;;; Generated autoloads from org/org-tempo.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-tempo" '("org-tempo-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "org-timer" "org/org-timer.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/org-timer.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-timer" '("org-timer-")))
+(register-definition-prefixes "org-tempo" '("org-tempo-"))
;;;***
@@ -24412,6 +24406,7 @@ Inserted by installing Org or when a release is made." nil nil)
;;; Generated autoloads from outline.el
(put 'outline-regexp 'safe-local-variable 'stringp)
(put 'outline-heading-end-regexp 'safe-local-variable 'stringp)
+(put 'outline-level 'risky-local-variable t)
(autoload 'outline-mode "outline" "\
Set major mode for editing outlines with selective display.
@@ -24441,113 +24436,22 @@ Turning on outline mode calls the value of `text-mode-hook' and then of
(autoload 'outline-minor-mode "outline" "\
Toggle Outline minor mode.
-If called interactively, enable Outline minor mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
-
-See the command `outline-mode' for more information on this mode.
-
-\(fn &optional ARG)" t nil)
-(put 'outline-level 'risky-local-variable t)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "outline" '("outline-")))
+If called interactively, toggle `Outline minor mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox" "org/ox.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ox.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox" '("org-export-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox-ascii" "org/ox-ascii.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ox-ascii.el
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-ascii" '("org-ascii-")))
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox-beamer" "org/ox-beamer.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ox-beamer.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-beamer" '("org-beamer-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox-html" "org/ox-html.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ox-html.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-html" '("org-html-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox-icalendar"
-;;;;;; "org/ox-icalendar.el" (0 0 0 0))
-;;; Generated autoloads from org/ox-icalendar.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-icalendar" '("org-icalendar-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox-latex" "org/ox-latex.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ox-latex.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-latex" '("org-latex-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox-man" "org/ox-man.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ox-man.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-man" '("org-man-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox-md" "org/ox-md.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ox-md.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-md" '("org-md-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox-odt" "org/ox-odt.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ox-odt.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-odt" '("org-odt-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox-org" "org/ox-org.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ox-org.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-org" '("org-org-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox-publish" "org/ox-publish.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ox-publish.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-publish" '("org-publish-")))
+See the command `outline-mode' for more information on this mode.
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ox-texinfo" "org/ox-texinfo.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from org/ox-texinfo.el
+\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ox-texinfo" '("org-texinfo-")))
+(register-definition-prefixes "outline" '("outline-"))
;;;***
@@ -24690,7 +24594,7 @@ The return value is a string (or nil in case we can't find it)." nil nil)
(function-put 'package-get-version 'pure 't)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-")))
+(register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-"))
;;;***
@@ -24713,14 +24617,14 @@ archive).
\(fn FILE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "package-x" '("package-")))
+(register-definition-prefixes "package-x" '("package-"))
;;;***
;;;### (autoloads nil "page-ext" "textmodes/page-ext.el" (0 0 0 0))
;;; Generated autoloads from textmodes/page-ext.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "page-ext" '("pages-")))
+(register-definition-prefixes "page-ext" '("pages-"))
;;;***
@@ -24740,10 +24644,16 @@ or call the function `show-paren-mode'.")
(autoload 'show-paren-mode "paren" "\
Toggle visualization of matching parens (Show Paren mode).
-If called interactively, enable Show-Paren mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Show-Paren mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Show Paren mode is a global minor mode. When enabled, any
matching parenthesis is highlighted in `show-paren-style' after
@@ -24751,7 +24661,7 @@ matching parenthesis is highlighted in `show-paren-style' after
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "paren" '("show-paren-")))
+(register-definition-prefixes "paren" '("show-paren-"))
;;;***
@@ -24762,8 +24672,9 @@ matching parenthesis is highlighted in `show-paren-style' after
(autoload 'parse-time-string "parse-time" "\
Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
-STRING should be something resembling an RFC 822 (or later) date-time, e.g.,
-\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is
+STRING should be an ISO 8601 time string, e.g., \"2020-01-15T16:12:21-08:00\",
+or something resembling an RFC 822 (or later) date-time, e.g.,
+\"Wed, 15 Jan 2020 16:12:21 -0800\". This function is
somewhat liberal in what format it accepts, and will attempt to
return a \"likely\" value even for somewhat malformed strings.
The values returned are identical to those of `decode-time', but
@@ -24772,7 +24683,7 @@ unknown DST value is returned as -1.
\(fn STRING)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "parse-time" '("parse-")))
+(register-definition-prefixes "parse-time" '("parse-"))
;;;***
@@ -24823,7 +24734,7 @@ See also the user variables `pascal-type-keywords', `pascal-start-keywords' and
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pascal" '("electric-pascal-" "pascal-")))
+(register-definition-prefixes "pascal" '("electric-pascal-" "pascal-"))
;;;***
@@ -24847,7 +24758,7 @@ Check if KEY is in the cache.
\(fn KEY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "password-cache" '("password-")))
+(register-definition-prefixes "password-cache" '("password-"))
;;;***
@@ -24981,7 +24892,7 @@ for the result of evaluating EXP (first arg to `pcase').
(function-put 'pcase-defmacro 'doc-string-elt '3)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcase" '("pcase-")))
+(register-definition-prefixes "pcase" '("pcase-"))
;;;***
@@ -24991,7 +24902,7 @@ for the result of evaluating EXP (first arg to `pcase').
(autoload 'pcomplete/cvs "pcmpl-cvs" "\
Completion rules for the `cvs' command." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-cvs" '("pcmpl-cvs-")))
+(register-definition-prefixes "pcmpl-cvs" '("pcmpl-cvs-"))
;;;***
@@ -25015,7 +24926,7 @@ Completion for the GNU find utility." nil nil)
(defalias 'pcomplete/gdb 'pcomplete/xargs)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-gnu" '("pcmpl-gnu-")))
+(register-definition-prefixes "pcmpl-gnu" '("pcmpl-gnu-"))
;;;***
@@ -25031,7 +24942,7 @@ Completion for GNU/Linux `umount'." nil nil)
(autoload 'pcomplete/mount "pcmpl-linux" "\
Completion for GNU/Linux `mount'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-linux" '("pcmpl-linux-" "pcomplete-pare-list")))
+(register-definition-prefixes "pcmpl-linux" '("pcmpl-linux-" "pcomplete-pare-list"))
;;;***
@@ -25041,7 +24952,7 @@ Completion for GNU/Linux `mount'." nil nil)
(autoload 'pcomplete/rpm "pcmpl-rpm" "\
Completion for the `rpm' command." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-rpm" '("pcmpl-rpm-")))
+(register-definition-prefixes "pcmpl-rpm" '("pcmpl-rpm-"))
;;;***
@@ -25080,7 +24991,12 @@ Completion rules for the `ssh' command." nil nil)
Completion rules for the `scp' command.
Includes files as well as host names followed by a colon." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-unix" '("pcmpl-")))
+(autoload 'pcomplete/telnet "pcmpl-unix" nil nil nil)
+
+(autoload 'pcomplete/rsh "pcmpl-unix" "\
+Complete `rsh', which, after the user and hostname, is like xargs." nil nil)
+
+(register-definition-prefixes "pcmpl-unix" '("pcmpl-" "pcomplete/"))
;;;***
@@ -25100,7 +25016,12 @@ long options." nil nil)
(autoload 'pcomplete/ag "pcmpl-x" "\
Completion for the `ag' command." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcmpl-x" '("pcmpl-x-")))
+(autoload 'pcomplete/bcc32 "pcmpl-x" "\
+Completion function for Borland's C++ compiler." nil nil)
+
+(defalias 'pcomplete/bcc 'pcomplete/bcc32)
+
+(register-definition-prefixes "pcmpl-x" '("pcmpl-x-"))
;;;***
@@ -25149,7 +25070,7 @@ this is `comint-dynamic-complete-functions'.
(autoload 'pcomplete-shell-setup "pcomplete" "\
Setup `shell-mode' to use pcomplete." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcomplete" '("pcomplete-")))
+(register-definition-prefixes "pcomplete" '("pcomplete-"))
;;;***
@@ -25226,7 +25147,7 @@ Anything else means to do it only if the prefix arg is equal to this value.")
Run `cvs-examine' if DIR is a CVS administrative directory.
The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp dir) (setq dir (directory-file-name dir)) (when (and (string= "CVS" (file-name-nondirectory dir)) (file-readable-p (expand-file-name "Entries" dir)) cvs-dired-use-hook (if (eq cvs-dired-use-hook 'always) (not current-prefix-arg) (equal current-prefix-arg cvs-dired-use-hook))) (save-excursion (funcall cvs-dired-action (file-name-directory dir) t t)))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs" '("cvs-" "defun-cvs-mode")))
+(register-definition-prefixes "pcvs" '("cvs-" "defun-cvs-mode"))
;;;***
@@ -25236,28 +25157,28 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d
(defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] `(menu-item ,(purecopy "Directory Status") cvs-status :help ,(purecopy "A more verbose status of a workarea"))) (define-key m [checkout] `(menu-item ,(purecopy "Checkout Module") cvs-checkout :help ,(purecopy "Check out a module from the repository"))) (define-key m [update] `(menu-item ,(purecopy "Update Directory") cvs-update :help ,(purecopy "Fetch updates from the repository"))) (define-key m [examine] `(menu-item ,(purecopy "Examine Directory") cvs-examine :help ,(purecopy "Examine the current state of a workarea"))) (fset 'cvs-global-menu m)) "\
Global menu used by PCL-CVS.")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-defs" '("cvs-")))
+(register-definition-prefixes "pcvs-defs" '("cvs-"))
;;;***
;;;### (autoloads nil "pcvs-info" "vc/pcvs-info.el" (0 0 0 0))
;;; Generated autoloads from vc/pcvs-info.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-info" '("cvs-")))
+(register-definition-prefixes "pcvs-info" '("cvs-"))
;;;***
;;;### (autoloads nil "pcvs-parse" "vc/pcvs-parse.el" (0 0 0 0))
;;; Generated autoloads from vc/pcvs-parse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-parse" '("cvs-")))
+(register-definition-prefixes "pcvs-parse" '("cvs-"))
;;;***
;;;### (autoloads nil "pcvs-util" "vc/pcvs-util.el" (0 0 0 0))
;;; Generated autoloads from vc/pcvs-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pcvs-util" '("cvs-")))
+(register-definition-prefixes "pcvs-util" '("cvs-"))
;;;***
@@ -25329,7 +25250,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "perl-mode" '("indent-perl-exp" "mark-perl-function" "perl-")))
+(register-definition-prefixes "perl-mode" '("indent-perl-exp" "mark-perl-function" "perl-"))
;;;***
@@ -25409,14 +25330,14 @@ they are not by default assigned to keys." t nil)
(defalias 'edit-picture 'picture-mode)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "picture" '("picture-")))
+(register-definition-prefixes "picture" '("picture-"))
;;;***
;;;### (autoloads nil "pinyin" "language/pinyin.el" (0 0 0 0))
;;; Generated autoloads from language/pinyin.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pinyin" '("pinyin-character-map")))
+(register-definition-prefixes "pinyin" '("pinyin-character-map"))
;;;***
@@ -25436,14 +25357,20 @@ or call the function `pixel-scroll-mode'.")
(autoload 'pixel-scroll-mode "pixel-scroll" "\
A minor mode to scroll text pixel-by-pixel.
-If called interactively, enable Pixel-Scroll mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Pixel-Scroll mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pixel-scroll" '("pixel-")))
+(register-definition-prefixes "pixel-scroll" '("pixel-"))
;;;***
@@ -25460,7 +25387,7 @@ Major mode for editing PLSTORE files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "plstore" '("plstore-")))
+(register-definition-prefixes "plstore" '("plstore-"))
;;;***
@@ -25473,7 +25400,7 @@ Called through `file-coding-system-alist', before the file is visited for real.
\(fn ARG-LIST)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "po" '("po-")))
+(register-definition-prefixes "po" '("po-"))
;;;***
@@ -25489,7 +25416,7 @@ pong-mode keybindings:\\<pong-mode-map>
\\{pong-mode-map}" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pong" '("pong-")))
+(register-definition-prefixes "pong" '("pong-"))
;;;***
@@ -25502,7 +25429,7 @@ Use streaming commands.
\(fn FILE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pop3" '("pop3-")))
+(register-definition-prefixes "pop3" '("pop3-"))
;;;***
@@ -25552,7 +25479,7 @@ Ignores leading comment characters.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pp" '("pp-")))
+(register-definition-prefixes "pp" '("pp-"))
;;;***
@@ -26092,7 +26019,7 @@ are both set to t.
\(fn &optional SELECT-PRINTER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "printing" '("lpr-setup" "pr-")))
+(register-definition-prefixes "printing" '("lpr-setup" "pr-"))
;;;***
@@ -26112,7 +26039,7 @@ Proced buffers.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "proced" '("proced-")))
+(register-definition-prefixes "proced" '("proced-"))
;;;***
@@ -26142,21 +26069,63 @@ Open profile FILENAME.
\(fn FILENAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "profiler" '("profiler-")))
+(register-definition-prefixes "profiler" '("profiler-"))
;;;***
;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0))
;;; Generated autoloads from progmodes/project.el
+(push (purecopy '(project 0 5 2)) package--builtin-versions)
(autoload 'project-current "project" "\
-Return the project instance in DIR or `default-directory'.
-When no project found in DIR, and MAYBE-PROMPT is non-nil, ask
-the user for a different directory to look in. If that directory
-is not a part of a detectable project either, return a
-`transient' project instance rooted in it.
+Return the project instance in DIRECTORY, defaulting to `default-directory'.
+
+When no project is found in that directory, the result depends on
+the value of MAYBE-PROMPT: if it is nil or omitted, return nil,
+else ask the user for a directory in which to look for the
+project, and if no project is found there, return a \"transient\"
+project instance.
+
+The \"transient\" project instance is a special kind of value
+which denotes a project rooted in that directory and includes all
+the files under the directory except for those that should be
+ignored (per `project-ignores').
-\(fn &optional MAYBE-PROMPT DIR)" nil nil)
+See the doc string of `project-find-functions' for the general form
+of the project instance object.
+
+\(fn &optional MAYBE-PROMPT DIRECTORY)" nil nil)
+
+(defvar project-prefix-map (let ((map (make-sparse-keymap))) (define-key map "!" 'project-shell-command) (define-key map "&" 'project-async-shell-command) (define-key map "f" 'project-find-file) (define-key map "F" 'project-or-external-find-file) (define-key map "b" 'project-switch-to-buffer) (define-key map "s" 'project-shell) (define-key map "d" 'project-dired) (define-key map "v" 'project-vc-dir) (define-key map "c" 'project-compile) (define-key map "e" 'project-eshell) (define-key map "k" 'project-kill-buffers) (define-key map "p" 'project-switch-project) (define-key map "g" 'project-find-regexp) (define-key map "G" 'project-or-external-find-regexp) (define-key map "r" 'project-query-replace-regexp) map) "\
+Keymap for project commands.")
+ (define-key ctl-x-map "p" project-prefix-map)
+
+(autoload 'project-other-window-command "project" "\
+Run project command, displaying resultant buffer in another window.
+
+The following commands are available:
+
+\\{project-prefix-map}
+\\{project-other-window-map}" t nil)
+ (define-key ctl-x-4-map "p" #'project-other-window-command)
+
+(autoload 'project-other-frame-command "project" "\
+Run project command, displaying resultant buffer in another frame.
+
+The following commands are available:
+
+\\{project-prefix-map}
+\\{project-other-frame-map}" t nil)
+ (define-key ctl-x-5-map "p" #'project-other-frame-command)
+
+(autoload 'project-other-tab-command "project" "\
+Run project command, displaying resultant buffer in a new tab.
+
+The following commands are available:
+
+\\{project-prefix-map}" t nil)
+
+(when (bound-and-true-p tab-prefix-map) (define-key tab-prefix-map "p" #'project-other-tab-command))
(autoload 'project-find-regexp "project" "\
Find all matches for REGEXP in the current project's roots.
@@ -26177,15 +26146,41 @@ pattern to search for.
\(fn REGEXP)" t nil)
(autoload 'project-find-file "project" "\
-Visit a file (with completion) in the current project's roots.
+Visit a file (with completion) in the current project.
The completion default is the filename at point, if one is
recognized." t nil)
(autoload 'project-or-external-find-file "project" "\
-Visit a file (with completion) in the current project's roots or external roots.
+Visit a file (with completion) in the current project or external roots.
The completion default is the filename at point, if one is
recognized." t nil)
+(autoload 'project-dired "project" "\
+Start Dired in the current project's root." t nil)
+
+(autoload 'project-vc-dir "project" "\
+Run VC-Dir in the current project's root." t nil)
+
+(autoload 'project-shell "project" "\
+Start an inferior shell in the current project's root directory.
+If a buffer already exists for running a shell in the project's root,
+switch to it. Otherwise, create a new shell buffer.
+With \\[universal-argument] prefix arg, create a new inferior shell buffer even
+if one already exists." t nil)
+
+(autoload 'project-eshell "project" "\
+Start Eshell in the current project's root directory.
+If a buffer already exists for running Eshell in the project's root,
+switch to it. Otherwise, create a new Eshell buffer.
+With \\[universal-argument] prefix arg, create a new Eshell buffer even
+if one already exists." t nil)
+
+(autoload 'project-async-shell-command "project" "\
+Run `async-shell-command' in the current project's root directory." t nil)
+
+(autoload 'project-shell-command "project" "\
+Run `shell-command' in the current project's root directory." t nil)
+
(autoload 'project-search "project" "\
Search for REGEXP in all the files of the project.
Stops when a match is found.
@@ -26202,7 +26197,82 @@ loop using the command \\[fileloop-continue].
\(fn FROM TO)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "project" '("project-")))
+(autoload 'project-compile "project" "\
+Run `compile' in the project root.
+Arguments the same as in `compile'.
+
+\(fn COMMAND &optional COMINT)" t nil)
+
+(autoload 'project-switch-to-buffer "project" "\
+Display buffer BUFFER-OR-NAME in the selected window.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical.
+
+\(fn BUFFER-OR-NAME)" t nil)
+
+(autoload 'project-display-buffer "project" "\
+Display BUFFER-OR-NAME in some window, without selecting it.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical.
+
+This function uses `display-buffer' as a subroutine, which see
+for how it is determined where the buffer will be displayed.
+
+\(fn BUFFER-OR-NAME)" t nil)
+
+(autoload 'project-display-buffer-other-frame "project" "\
+Display BUFFER-OR-NAME preferably in another frame.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical.
+
+This function uses `display-buffer-other-frame' as a subroutine,
+which see for how it is determined where the buffer will be
+displayed.
+
+\(fn BUFFER-OR-NAME)" t nil)
+
+(autoload 'project-kill-buffers "project" "\
+Kill the buffers belonging to the current project.
+Two buffers belong to the same project if their project
+instances, as reported by `project-current' in each buffer, are
+identical. Only the buffers that match a condition in
+`project-kill-buffer-conditions' will be killed. If NO-CONFIRM
+is non-nil, the command will not ask the user for confirmation.
+NO-CONFIRM is always nil when the command is invoked
+interactively.
+
+\(fn &optional NO-CONFIRM)" t nil)
+
+(autoload 'project-remember-project "project" "\
+Add project PR to the front of the project list.
+Save the result in `project-list-file' if the list of projects has changed.
+
+\(fn PR)" nil nil)
+
+(autoload 'project-known-project-roots "project" "\
+Return the list of root directories of all known projects." nil nil)
+
+(defvar project-switch-commands '((102 "Find file" project-find-file) (103 "Find regexp" project-find-regexp) (100 "Dired" project-dired) (118 "VC-Dir" project-vc-dir) (101 "Eshell" project-eshell)) "\
+Alist mapping keys to project switching menu entries.
+Used by `project-switch-project' to construct a dispatch menu of
+commands available upon \"switching\" to another project.
+
+Each element is of the form (KEY LABEL COMMAND), where COMMAND is the
+command to run when KEY is pressed. LABEL is used to distinguish
+the menu entries in the dispatch menu.")
+
+(autoload 'project-switch-project "project" "\
+\"Switch\" to another project by running an Emacs command.
+The available commands are presented as a dispatch menu
+made from `project-switch-commands'." t nil)
+
+(register-definition-prefixes "project" '("project-"))
;;;***
@@ -26237,7 +26307,7 @@ With prefix argument ARG, restart the Prolog process if running before.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "prolog" '("mercury-mode-map" "prolog-")))
+(register-definition-prefixes "prolog" '("mercury-mode-map" "prolog-"))
;;;***
@@ -26250,14 +26320,14 @@ The default value is (\"/usr/local/share/emacs/fonts/bdf\").")
(custom-autoload 'bdf-directory-list "ps-bdf" t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-bdf" '("bdf-")))
+(register-definition-prefixes "ps-bdf" '("bdf-"))
;;;***
;;;### (autoloads nil "ps-def" "ps-def.el" (0 0 0 0))
;;; Generated autoloads from ps-def.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-def" '("ps-")))
+(register-definition-prefixes "ps-def" '("ps-"))
;;;***
@@ -26305,15 +26375,7 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-mode" '("ps-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "ps-mule" "ps-mule.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from ps-mule.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-mule" '("ps-mule-")))
+(register-definition-prefixes "ps-mode" '("ps-"))
;;;***
@@ -26502,14 +26564,14 @@ If EXTENSION is any other symbol, it is ignored.
\(fn FACE-EXTENSION &optional MERGE-P ALIST-SYM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-print" '("ps-")))
+(register-definition-prefixes "ps-print" '("ps-"))
;;;***
;;;### (autoloads nil "ps-samp" "ps-samp.el" (0 0 0 0))
;;; Generated autoloads from ps-samp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ps-samp" '("ps-")))
+(register-definition-prefixes "ps-samp" '("ps-"))
;;;***
@@ -26529,20 +26591,20 @@ Optional argument FACE specifies the face to do the highlighting.
\(fn START END &optional FACE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pulse" '("pulse-")))
+(register-definition-prefixes "pulse" '("pulse-"))
;;;***
;;;### (autoloads nil "puny" "net/puny.el" (0 0 0 0))
;;; Generated autoloads from net/puny.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "puny" '("puny-")))
+(register-definition-prefixes "puny" '("puny-"))
;;;***
;;;### (autoloads nil "python" "progmodes/python.el" (0 0 0 0))
;;; Generated autoloads from progmodes/python.el
-(push (purecopy '(python 0 26 1)) package--builtin-versions)
+(push (purecopy '(python 0 27)) package--builtin-versions)
(add-to-list 'auto-mode-alist (cons (purecopy "\\.py[iw]?\\'") 'python-mode))
@@ -26575,7 +26637,7 @@ Major mode for editing Python files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "python" '("inferior-python-mode" "python-" "run-python-internal")))
+(register-definition-prefixes "python" '("inferior-python-mode" "python-" "run-python-internal"))
;;;***
@@ -26596,7 +26658,7 @@ them into characters should be done separately.
\(fn FROM TO &optional CODING-SYSTEM)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "qp" '("quoted-printable-")))
+(register-definition-prefixes "qp" '("quoted-printable-"))
;;;***
@@ -26826,7 +26888,7 @@ of each directory.
\(fn DIRNAME &rest DIRNAMES)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail" '("quail-")))
+(register-definition-prefixes "quail" '("quail-"))
;;;***
@@ -26834,7 +26896,7 @@ of each directory.
;;;;;; 0 0 0))
;;; Generated autoloads from leim/quail/ethiopic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/ethiopic" '("ethio-select-a-translation")))
+(register-definition-prefixes "quail/ethiopic" '("ethio-select-a-translation"))
;;;***
@@ -26849,7 +26911,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'.
\(fn INPUT-METHOD FUNC HELP-TEXT &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/hangul" '("alphabetp" "hangul" "notzerop")))
+(register-definition-prefixes "quail/hangul" '("alphabetp" "hangul" "notzerop"))
;;;***
@@ -26857,14 +26919,14 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'.
;;;;;; 0 0))
;;; Generated autoloads from leim/quail/indian.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/indian" '("inscript-" "quail-")))
+(register-definition-prefixes "quail/indian" '("indian-mlm-mozhi-u" "inscript-" "quail-"))
;;;***
;;;### (autoloads nil "quail/ipa" "leim/quail/ipa.el" (0 0 0 0))
;;; Generated autoloads from leim/quail/ipa.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/ipa" '("ipa-x-sampa-")))
+(register-definition-prefixes "quail/ipa" '("ipa-x-sampa-"))
;;;***
@@ -26872,21 +26934,21 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'.
;;;;;; 0 0 0))
;;; Generated autoloads from leim/quail/japanese.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/japanese" '("quail-japanese-")))
+(register-definition-prefixes "quail/japanese" '("quail-japanese-"))
;;;***
;;;### (autoloads nil "quail/lao" "leim/quail/lao.el" (0 0 0 0))
;;; Generated autoloads from leim/quail/lao.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/lao" '("lao-" "quail-lao-update-translation")))
+(register-definition-prefixes "quail/lao" '("lao-" "quail-lao-update-translation"))
;;;***
;;;### (autoloads nil "quail/lrt" "leim/quail/lrt.el" (0 0 0 0))
;;; Generated autoloads from leim/quail/lrt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/lrt" '("quail-lrt-update-translation")))
+(register-definition-prefixes "quail/lrt" '("quail-lrt-update-translation"))
;;;***
@@ -26894,14 +26956,14 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'.
;;;;;; 0 0 0))
;;; Generated autoloads from leim/quail/sisheng.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/sisheng" '("quail-make-sisheng-rules" "sisheng-")))
+(register-definition-prefixes "quail/sisheng" '("quail-make-sisheng-rules" "sisheng-"))
;;;***
;;;### (autoloads nil "quail/thai" "leim/quail/thai.el" (0 0 0 0))
;;; Generated autoloads from leim/quail/thai.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/thai" '("thai-generate-quail-map")))
+(register-definition-prefixes "quail/thai" '("thai-generate-quail-map"))
;;;***
@@ -26909,7 +26971,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'.
;;;;;; 0 0 0))
;;; Generated autoloads from leim/quail/tibetan.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/tibetan" '("quail-tib" "tibetan-")))
+(register-definition-prefixes "quail/tibetan" '("quail-tib" "tibetan-"))
;;;***
@@ -26926,14 +26988,14 @@ While this input method is active, the variable
\(fn &optional ARG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/uni-input" '("ucs-input-")))
+(register-definition-prefixes "quail/uni-input" '("ucs-input-"))
;;;***
;;;### (autoloads nil "quail/viqr" "leim/quail/viqr.el" (0 0 0 0))
;;; Generated autoloads from leim/quail/viqr.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quail/viqr" '("viet-quail-define-rules")))
+(register-definition-prefixes "quail/viqr" '("viet-quail-define-rules"))
;;;***
@@ -27002,7 +27064,7 @@ The key bindings for `quickurl-list-mode' are:
(autoload 'quickurl-list "quickurl" "\
Display `quickurl-list' as a formatted list using `quickurl-list-mode'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "quickurl" '("quickurl-")))
+(register-definition-prefixes "quickurl" '("quickurl-"))
;;;***
@@ -27010,7 +27072,7 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'." t nil)
;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/radix-tree.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "radix-tree" '("radix-tree-")))
+(register-definition-prefixes "radix-tree" '("radix-tree-"))
;;;***
@@ -27046,14 +27108,20 @@ or call the function `rcirc-track-minor-mode'.")
(autoload 'rcirc-track-minor-mode "rcirc" "\
Global minor mode for tracking activity in rcirc buffers.
-If called interactively, enable Rcirc-Track minor mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Rcirc-Track minor mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rcirc" '("defun-rcirc-command" "rcirc-" "set-rcirc-" "with-rcirc-")))
+(register-definition-prefixes "rcirc" '("defun-rcirc-command" "rcirc-" "set-rcirc-" "with-rcirc-"))
;;;***
@@ -27072,7 +27140,7 @@ in another window, initially containing an empty regexp.
As you edit the regexp in the \"*RE-Builder*\" buffer, the
matching parts of the target buffer will be highlighted." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "re-builder" '("re-builder-unload-function" "reb-")))
+(register-definition-prefixes "re-builder" '("re-builder-unload-function" "reb-"))
;;;***
@@ -27092,10 +27160,16 @@ or call the function `recentf-mode'.")
(autoload 'recentf-mode "recentf" "\
Toggle \"Open Recent\" menu (Recentf mode).
-If called interactively, enable Recentf mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Recentf mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Recentf mode is enabled, a \"Open Recent\" submenu is
displayed in the \"File\" menu, containing a list of files that
@@ -27103,7 +27177,7 @@ were operated on recently, in the most-recently-used order.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "recentf" '("recentf-")))
+(register-definition-prefixes "recentf" '("recentf-"))
;;;***
@@ -27244,30 +27318,36 @@ with a prefix argument, prompt for START-AT and FORMAT.
(autoload 'rectangle-mark-mode "rect" "\
Toggle the region as rectangular.
-If called interactively, enable Rectangle-Mark mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Rectangle-Mark mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Activates the region if needed. Only lasts until the region is deactivated.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-")))
+(register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-"))
;;;***
;;;### (autoloads nil "refbib" "textmodes/refbib.el" (0 0 0 0))
;;; Generated autoloads from textmodes/refbib.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "refbib" '("r2b-")))
+(register-definition-prefixes "refbib" '("r2b-"))
;;;***
;;;### (autoloads nil "refer" "textmodes/refer.el" (0 0 0 0))
;;; Generated autoloads from textmodes/refer.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "refer" '("refer-")))
+(register-definition-prefixes "refer" '("refer-"))
;;;***
@@ -27277,10 +27357,16 @@ Activates the region if needed. Only lasts until the region is deactivated.
(autoload 'refill-mode "refill" "\
Toggle automatic refilling (Refill mode).
-If called interactively, enable Refill mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Refill mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Refill mode is a buffer-local minor mode. When enabled, the
current paragraph is refilled as you edit. Self-inserting
@@ -27291,7 +27377,7 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "refill" '("refill-")))
+(register-definition-prefixes "refill" '("refill-"))
;;;***
@@ -27308,10 +27394,16 @@ Turn on RefTeX mode." nil nil)
(autoload 'reftex-mode "reftex" "\
Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX.
-If called interactively, enable Reftex mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Reftex mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\\<reftex-mode-map>A Table of Contents of the entire (multifile) document with browsing
capabilities is available with `\\[reftex-toc]'.
@@ -27347,79 +27439,7 @@ on the menu bar.
Reset the symbols containing information from buffer scanning.
This enforces rescanning the buffer on next use." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex" '("reftex-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "reftex-auc" "textmodes/reftex-auc.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from textmodes/reftex-auc.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-auc" '("reftex-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "reftex-cite"
-;;;;;; "textmodes/reftex-cite.el" (0 0 0 0))
-;;; Generated autoloads from textmodes/reftex-cite.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-cite" '("reftex-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "reftex-dcr" "textmodes/reftex-dcr.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from textmodes/reftex-dcr.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-dcr" '("reftex-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "reftex-global"
-;;;;;; "textmodes/reftex-global.el" (0 0 0 0))
-;;; Generated autoloads from textmodes/reftex-global.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-global" '("reftex-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "reftex-index"
-;;;;;; "textmodes/reftex-index.el" (0 0 0 0))
-;;; Generated autoloads from textmodes/reftex-index.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-index" '("reftex-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "reftex-parse"
-;;;;;; "textmodes/reftex-parse.el" (0 0 0 0))
-;;; Generated autoloads from textmodes/reftex-parse.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-parse" '("reftex-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "reftex-ref" "textmodes/reftex-ref.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from textmodes/reftex-ref.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-ref" '("reftex-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "reftex-sel" "textmodes/reftex-sel.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from textmodes/reftex-sel.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-sel" '("reftex-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "reftex-toc" "textmodes/reftex-toc.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from textmodes/reftex-toc.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-toc" '("reftex-")))
+(register-definition-prefixes "reftex" '("reftex-"))
;;;***
@@ -27431,7 +27451,7 @@ This enforces rescanning the buffer on next use." nil nil)
(put 'reftex-level-indent 'safe-local-variable 'integerp)
(put 'reftex-guess-label-type 'safe-local-variable (lambda (x) (memq x '(nil t))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reftex-vars" '("reftex-")))
+(register-definition-prefixes "reftex-vars" '("reftex-"))
;;;***
@@ -27495,28 +27515,26 @@ This means the number of non-shy regexp grouping constructs
\(fn REGEXP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "regexp-opt" '("regexp-opt-")))
+(register-definition-prefixes "regexp-opt" '("regexp-opt-"))
;;;***
;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/regi.el
-(push (purecopy '(regi 1 8)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "regi" '("regi-")))
+(register-definition-prefixes "regi" '("regi-"))
;;;***
;;;### (autoloads nil "registry" "registry.el" (0 0 0 0))
;;; Generated autoloads from registry.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "registry" '("registry-")))
+(register-definition-prefixes "registry" '("registry-"))
;;;***
;;;### (autoloads nil "remember" "textmodes/remember.el" (0 0 0 0))
;;; Generated autoloads from textmodes/remember.el
-(push (purecopy '(remember 2 0)) package--builtin-versions)
(autoload 'remember "remember" "\
Remember an arbitrary piece of data.
@@ -27562,13 +27580,12 @@ to turn the *scratch* buffer into your notes buffer.
\(fn &optional SWITCH-TO)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "remember" '("remember-")))
+(register-definition-prefixes "remember" '("remember-"))
;;;***
;;;### (autoloads nil "repeat" "repeat.el" (0 0 0 0))
;;; Generated autoloads from repeat.el
-(push (purecopy '(repeat 0 51)) package--builtin-versions)
(autoload 'repeat "repeat" "\
Repeat most recently executed command.
@@ -27587,7 +27604,7 @@ recently executed command not bound to an input event\".
\(fn REPEAT-ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "repeat" '("repeat-")))
+(register-definition-prefixes "repeat" '("repeat-"))
;;;***
@@ -27620,7 +27637,7 @@ mail-sending package is used for editing and sending the message.
\(fn ADDRESS PKGNAME VARLIST &optional PRE-HOOKS POST-HOOKS SALUTATION)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reporter" '("reporter-")))
+(register-definition-prefixes "reporter" '("reporter-"))
;;;***
@@ -27648,7 +27665,7 @@ first comment line visible (if point is in a comment).
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reposition" '("repos-count-screen-lines")))
+(register-definition-prefixes "reposition" '("repos-count-screen-lines"))
;;;***
@@ -27658,14 +27675,22 @@ first comment line visible (if point is in a comment).
(autoload 'reveal-mode "reveal" "\
Toggle uncloaking of invisible text near point (Reveal mode).
-If called interactively, enable Reveal mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Reveal mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Reveal mode is a buffer-local minor mode. When enabled, it
reveals invisible text around point.
+Also see the `reveal-auto-hide' variable.
+
\(fn &optional ARG)" t nil)
(defvar global-reveal-mode nil "\
@@ -27682,14 +27707,20 @@ or call the function `global-reveal-mode'.")
Toggle Reveal mode in all buffers (Global Reveal mode).
Reveal mode renders invisible text around point visible again.
-If called interactively, enable Global Reveal mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Global Reveal mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "reveal" '("reveal-")))
+(register-definition-prefixes "reveal" '("reveal-"))
;;;***
@@ -27697,49 +27728,49 @@ enable the mode if ARG is omitted or nil, and toggle it if ARG is
;;;;;; 0))
;;; Generated autoloads from international/rfc1843.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc1843" '("rfc1843-")))
+(register-definition-prefixes "rfc1843" '("rfc1843-"))
;;;***
;;;### (autoloads nil "rfc2045" "mail/rfc2045.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc2045.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2045" '("rfc2045-encode-string")))
+(register-definition-prefixes "rfc2045" '("rfc2045-encode-string"))
;;;***
;;;### (autoloads nil "rfc2047" "mail/rfc2047.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc2047.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2047" '("rfc2047-")))
+(register-definition-prefixes "rfc2047" '("rfc2047-"))
;;;***
;;;### (autoloads nil "rfc2104" "net/rfc2104.el" (0 0 0 0))
;;; Generated autoloads from net/rfc2104.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2104" '("rfc2104-")))
+(register-definition-prefixes "rfc2104" '("rfc2104-"))
;;;***
;;;### (autoloads nil "rfc2231" "mail/rfc2231.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc2231.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2231" '("rfc2231-")))
+(register-definition-prefixes "rfc2231" '("rfc2231-"))
;;;***
;;;### (autoloads nil "rfc2368" "mail/rfc2368.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc2368.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc2368" '("rfc2368-")))
+(register-definition-prefixes "rfc2368" '("rfc2368-"))
;;;***
;;;### (autoloads nil "rfc822" "mail/rfc822.el" (0 0 0 0))
;;; Generated autoloads from mail/rfc822.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rfc822" '("rfc822-")))
+(register-definition-prefixes "rfc822" '("rfc822-"))
;;;***
@@ -27756,7 +27787,7 @@ Make a ring that can contain SIZE elements.
\(fn SIZE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ring" '("ring-")))
+(register-definition-prefixes "ring" '("ring-"))
;;;***
@@ -27802,7 +27833,7 @@ variable.
\(fn INPUT-ARGS &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rlogin" '("rlogin-")))
+(register-definition-prefixes "rlogin" '("rlogin-"))
;;;***
@@ -27999,7 +28030,7 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server.
\(fn PASSWORD)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmail" '("mail-" "rmail-")))
+(register-definition-prefixes "rmail" '("mail-" "rmail-"))
;;;***
@@ -28007,31 +28038,7 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server.
;;;;;; (0 0 0 0))
;;; Generated autoloads from mail/rmail-spam-filter.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmail-spam-filter" '("rmail-" "rsf-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "rmailedit" "mail/rmailedit.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from mail/rmailedit.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailedit" '("rmail-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "rmailkwd" "mail/rmailkwd.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from mail/rmailkwd.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailkwd" '("rmail-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "rmailmm" "mail/rmailmm.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from mail/rmailmm.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailmm" '("rmail-")))
+(register-definition-prefixes "rmail-spam-filter" '("rmail-" "rsf-"))
;;;***
@@ -28103,23 +28110,7 @@ than appending to it. Deletes the message after writing if
\(fn FILE-NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailout" '("rmail-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "rmailsort" "mail/rmailsort.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from mail/rmailsort.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailsort" '("rmail-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "rmailsum" "mail/rmailsum.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from mail/rmailsum.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rmailsum" '("rmail-")))
+(register-definition-prefixes "rmailout" '("rmail-"))
;;;***
@@ -28172,35 +28163,35 @@ Return a pattern.
\(fn FILENAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-cmpct" '("rng-")))
+(register-definition-prefixes "rng-cmpct" '("rng-"))
;;;***
;;;### (autoloads nil "rng-dt" "nxml/rng-dt.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-dt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-dt" '("rng-dt-")))
+(register-definition-prefixes "rng-dt" '("rng-dt-"))
;;;***
;;;### (autoloads nil "rng-loc" "nxml/rng-loc.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-loc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-loc" '("rng-")))
+(register-definition-prefixes "rng-loc" '("rng-"))
;;;***
;;;### (autoloads nil "rng-maint" "nxml/rng-maint.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-maint.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-maint" '("rng-")))
+(register-definition-prefixes "rng-maint" '("rng-"))
;;;***
;;;### (autoloads nil "rng-match" "nxml/rng-match.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-match.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-match" '("rng-")))
+(register-definition-prefixes "rng-match" '("rng-"))
;;;***
@@ -28212,35 +28203,35 @@ Initialize `nxml-mode' to take advantage of `rng-validate-mode'.
This is typically called from `nxml-mode-hook'.
Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-nxml" '("rng-")))
+(register-definition-prefixes "rng-nxml" '("rng-"))
;;;***
;;;### (autoloads nil "rng-parse" "nxml/rng-parse.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-parse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-parse" '("rng-parse-")))
+(register-definition-prefixes "rng-parse" '("rng-parse-"))
;;;***
;;;### (autoloads nil "rng-pttrn" "nxml/rng-pttrn.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-pttrn.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-pttrn" '("rng-")))
+(register-definition-prefixes "rng-pttrn" '("rng-"))
;;;***
;;;### (autoloads nil "rng-uri" "nxml/rng-uri.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-uri.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-uri" '("rng-")))
+(register-definition-prefixes "rng-uri" '("rng-"))
;;;***
;;;### (autoloads nil "rng-util" "nxml/rng-util.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-util" '("rng-")))
+(register-definition-prefixes "rng-util" '("rng-"))
;;;***
@@ -28250,10 +28241,16 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." t nil)
(autoload 'rng-validate-mode "rng-valid" "\
Minor mode performing continual validation against a RELAX NG schema.
-If called interactively, enable Rng-Validate mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Rng-Validate mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Checks whether the buffer is a well-formed XML 1.0 document,
conforming to the XML Namespaces Recommendation and valid against a
@@ -28277,7 +28274,7 @@ to use for finding the schema.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-valid" '("rng-")))
+(register-definition-prefixes "rng-valid" '("rng-"))
;;;***
@@ -28306,7 +28303,7 @@ must be equal.
\(fn NAME PARAMS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rng-xsd" '("rng-xsd-" "xsd-duration-reference-dates")))
+(register-definition-prefixes "rng-xsd" '("rng-xsd-" "xsd-duration-reference-dates"))
;;;***
@@ -28340,7 +28337,7 @@ Start using robin package NAME, which is a string.
\(fn NAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "robin" '("robin-")))
+(register-definition-prefixes "robin" '("robin-"))
;;;***
@@ -28378,7 +28375,7 @@ See also `toggle-rot13-mode'." t nil)
(autoload 'toggle-rot13-mode "rot13" "\
Toggle the use of ROT13 encoding for the current window." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rot13" '("rot13-")))
+(register-definition-prefixes "rot13" '("rot13-"))
;;;***
@@ -28401,10 +28398,16 @@ highlighting.
(autoload 'rst-minor-mode "rst" "\
Toggle ReST minor mode.
-If called interactively, enable Rst minor mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Rst minor mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When ReST minor mode is enabled, the ReST mode keybindings
are installed on top of the major mode bindings. Use this
@@ -28412,14 +28415,14 @@ for modes derived from Text mode, like Mail mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rst" '("rst-")))
+(register-definition-prefixes "rst" '("rst-"))
;;;***
;;;### (autoloads nil "rtree" "rtree.el" (0 0 0 0))
;;; Generated autoloads from rtree.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rtree" '("rtree-")))
+(register-definition-prefixes "rtree" '("rtree-"))
;;;***
@@ -28437,13 +28440,12 @@ Major mode for editing Ruby code.
(dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'ruby-mode)))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ruby-mode" '("ruby-")))
+(register-definition-prefixes "ruby-mode" '("ruby-"))
;;;***
;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (0 0 0 0))
;;; Generated autoloads from ruler-mode.el
-(push (purecopy '(ruler-mode 1 6)) package--builtin-versions)
(defvar ruler-mode nil "\
Non-nil if Ruler mode is enabled.
@@ -28452,14 +28454,20 @@ Use the command `ruler-mode' to change this variable.")
(autoload 'ruler-mode "ruler-mode" "\
Toggle display of ruler in header line (Ruler mode).
-If called interactively, enable Ruler mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Ruler mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ruler-mode" '("ruler-")))
+(register-definition-prefixes "ruler-mode" '("ruler-"))
;;;***
@@ -28651,38 +28659,37 @@ For more details, see Info node `(elisp) Extending Rx'.
\(fn NAME [(ARGS...)] RX)" nil t)
-(function-put 'rx-define 'lisp-indent-function '1)
+(function-put 'rx-define 'lisp-indent-function 'defun)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "rx" '("rx-")))
+(register-definition-prefixes "rx" '("rx-"))
;;;***
;;;### (autoloads nil "sasl" "net/sasl.el" (0 0 0 0))
;;; Generated autoloads from net/sasl.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl" '("sasl-")))
+(register-definition-prefixes "sasl" '("sasl-"))
;;;***
;;;### (autoloads nil "sasl-cram" "net/sasl-cram.el" (0 0 0 0))
;;; Generated autoloads from net/sasl-cram.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-cram" '("sasl-cram-md5-")))
+(register-definition-prefixes "sasl-cram" '("sasl-cram-md5-"))
;;;***
;;;### (autoloads nil "sasl-digest" "net/sasl-digest.el" (0 0 0 0))
;;; Generated autoloads from net/sasl-digest.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-digest" '("sasl-digest-md5-")))
+(register-definition-prefixes "sasl-digest" '("sasl-digest-md5-"))
;;;***
;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (0 0 0 0))
;;; Generated autoloads from net/sasl-ntlm.el
-(push (purecopy '(sasl 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-ntlm" '("sasl-ntlm-")))
+(register-definition-prefixes "sasl-ntlm" '("sasl-ntlm-"))
;;;***
@@ -28690,13 +28697,20 @@ For more details, see Info node `(elisp) Extending Rx'.
;;;;;; 0 0 0))
;;; Generated autoloads from net/sasl-scram-rfc.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-scram-rfc" '("sasl-scram-")))
+(register-definition-prefixes "sasl-scram-rfc" '("sasl-scram-"))
+
+;;;***
+
+;;;### (autoloads nil "sasl-scram-sha256" "net/sasl-scram-sha256.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from net/sasl-scram-sha256.el
+
+(register-definition-prefixes "sasl-scram-sha256" '("sasl-scram-sha"))
;;;***
;;;### (autoloads nil "savehist" "savehist.el" (0 0 0 0))
;;; Generated autoloads from savehist.el
-(push (purecopy '(savehist 24)) package--builtin-versions)
(defvar savehist-mode nil "\
Non-nil if Savehist mode is enabled.
@@ -28711,10 +28725,16 @@ or call the function `savehist-mode'.")
(autoload 'savehist-mode "savehist" "\
Toggle saving of minibuffer history (Savehist mode).
-If called interactively, enable Savehist mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Savehist mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Savehist mode is enabled, minibuffer history is saved
to `savehist-file' periodically and when exiting Emacs. When
@@ -28744,7 +28764,7 @@ histories, which is probably undesirable.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "savehist" '("savehist-")))
+(register-definition-prefixes "savehist" '("savehist-"))
;;;***
@@ -28766,10 +28786,16 @@ Non-nil means automatically save place in each file.
This means when you visit a file, point goes to the last place
where it was when you previously visited the same file.
-If called interactively, enable Save-Place mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Save-Place mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
@@ -28779,10 +28805,16 @@ If this mode is enabled, point is recorded when you kill the buffer
or exit Emacs. Visiting this file again will go to that position,
even in a later Emacs session.
-If called interactively, enable Save-Place-Local mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Save-Place-Local mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
To save places automatically in all files, put this in your init
file:
@@ -28791,14 +28823,7 @@ file:
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "saveplace" '("load-save-place-alist-from-file" "save-place")))
-
-;;;***
-
-;;;### (autoloads nil "sb-image" "sb-image.el" (0 0 0 0))
-;;; Generated autoloads from sb-image.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sb-image" '("defimage-speedbar" "speedbar-")))
+(register-definition-prefixes "saveplace" '("load-save-place-alist-from-file" "save-place"))
;;;***
@@ -28839,7 +28864,7 @@ that variable's value is a string.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scheme" '("dsssl-" "scheme-")))
+(register-definition-prefixes "scheme" '("dsssl-" "scheme-"))
;;;***
@@ -28854,7 +28879,7 @@ This mode is an extended emacs-lisp mode.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "score-mode" '("gnus-score-" "score-mode-")))
+(register-definition-prefixes "score-mode" '("gnus-score-" "score-mode-"))
;;;***
@@ -28874,24 +28899,30 @@ or call the function `scroll-all-mode'.")
(autoload 'scroll-all-mode "scroll-all" "\
Toggle shared scrolling in same-frame windows (Scroll-All mode).
-If called interactively, enable Scroll-All mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Scroll-All mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Scroll-All mode is enabled, scrolling commands invoked in
one window apply to all visible windows in the same frame.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scroll-all" '("scroll-all-")))
+(register-definition-prefixes "scroll-all" '("scroll-all-"))
;;;***
;;;### (autoloads nil "scroll-bar" "scroll-bar.el" (0 0 0 0))
;;; Generated autoloads from scroll-bar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scroll-bar" '("get-scroll-bar-mode" "horizontal-scroll-bar" "previous-scroll-bar-mode" "scroll-bar-" "set-scroll-bar-mode" "toggle-")))
+(register-definition-prefixes "scroll-bar" '("get-scroll-bar-mode" "horizontal-scroll-bar" "previous-scroll-bar-mode" "scroll-bar-" "set-scroll-bar-mode" "toggle-"))
;;;***
@@ -28901,10 +28932,16 @@ one window apply to all visible windows in the same frame.
(autoload 'scroll-lock-mode "scroll-lock" "\
Buffer-local minor mode for pager-like scrolling.
-If called interactively, enable Scroll-Lock mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Scroll-Lock mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When enabled, keys that normally move point by line or paragraph
will scroll the buffer by the respective amount of lines instead
@@ -28916,7 +28953,7 @@ MS-Windows systems if `w32-scroll-lock-modifier' is non-nil.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "scroll-lock" '("scroll-lock-")))
+(register-definition-prefixes "scroll-lock" '("scroll-lock-"))
;;;***
@@ -28925,7 +28962,7 @@ MS-Windows systems if `w32-scroll-lock-modifier' is non-nil.
(when (featurep 'dbusbind)
(autoload 'secrets-show-secrets "secrets" nil t))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "secrets" '("secrets-")))
+(register-definition-prefixes "secrets" '("secrets-"))
;;;***
@@ -28972,10 +29009,16 @@ or call the function `semantic-mode'.")
(autoload 'semantic-mode "semantic" "\
Toggle parser features (Semantic mode).
-If called interactively, enable Semantic mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Semantic mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
In Semantic mode, Emacs parses the buffers you visit for their
semantic content. This information is used by a variety of
@@ -28987,23 +29030,7 @@ Semantic mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic" '("bovinate" "semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/analyze"
-;;;;;; "cedet/semantic/analyze.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/analyze.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze" '("semantic-a")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/analyze/complete"
-;;;;;; "cedet/semantic/analyze/complete.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/analyze/complete.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/complete" '("semantic-analyze-")))
+(register-definition-prefixes "semantic" '("bovinate" "semantic-"))
;;;***
@@ -29011,7 +29038,7 @@ Semantic mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/analyze/debug.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/debug" '("semantic-analyze")))
+(register-definition-prefixes "semantic/analyze/debug" '("semantic-analyze"))
;;;***
@@ -29019,31 +29046,7 @@ Semantic mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/analyze/fcn.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/fcn" '("semantic-analyze-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/analyze/refs"
-;;;;;; "cedet/semantic/analyze/refs.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/analyze/refs.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/analyze/refs" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine"
-;;;;;; "cedet/semantic/bovine.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/bovine.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/c"
-;;;;;; "cedet/semantic/bovine/c.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/bovine/c.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/c" '("c-mode" "semantic")))
+(register-definition-prefixes "semantic/analyze/fcn" '("semantic-analyze-"))
;;;***
@@ -29051,23 +29054,7 @@ Semantic mode.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/bovine/debug.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/debug" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/el"
-;;;;;; "cedet/semantic/bovine/el.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/bovine/el.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/el" '("emacs-lisp-mode" "semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/gcc"
-;;;;;; "cedet/semantic/bovine/gcc.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/bovine/gcc.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/gcc" '("semantic-")))
+(register-definition-prefixes "semantic/bovine/debug" '("semantic-"))
;;;***
@@ -29080,23 +29067,7 @@ Major mode for editing Bovine grammars.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/grammar" '("bovine-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/make"
-;;;;;; "cedet/semantic/bovine/make.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/bovine/make.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/make" '("makefile-mode" "semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/bovine/scm"
-;;;;;; "cedet/semantic/bovine/scm.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/bovine/scm.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/bovine/scm" '("semantic-")))
+(register-definition-prefixes "semantic/bovine/grammar" '("bovine-"))
;;;***
@@ -29104,31 +29075,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/chart.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/chart" '("semantic-chart-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/complete"
-;;;;;; "cedet/semantic/complete.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/complete.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/complete" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/ctxt"
-;;;;;; "cedet/semantic/ctxt.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/ctxt.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ctxt" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/db"
-;;;;;; "cedet/semantic/db.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/db.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db" '("semanticdb-")))
+(register-definition-prefixes "semantic/chart" '("semantic-chart-"))
;;;***
@@ -29136,7 +29083,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-debug.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-debug" '("semanticdb-")))
+(register-definition-prefixes "semantic/db-debug" '("semanticdb-"))
;;;***
@@ -29144,7 +29091,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-ebrowse.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-ebrowse" '("c++-mode" "semanticdb-")))
+(register-definition-prefixes "semantic/db-ebrowse" '("c++-mode" "semanticdb-"))
;;;***
@@ -29152,31 +29099,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-el.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-el" '("emacs-lisp-mode" "semanticdb-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-file"
-;;;;;; "cedet/semantic/db-file.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/db-file.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-file" '("semanticdb-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-find"
-;;;;;; "cedet/semantic/db-find.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/db-find.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-find" '("semanticdb-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-global"
-;;;;;; "cedet/semantic/db-global.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/db-global.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-global" '("semanticdb-")))
+(register-definition-prefixes "semantic/db-el" '("emacs-lisp-mode" "semanticdb-"))
;;;***
@@ -29184,15 +29107,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-javascript.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-javascript" '("javascript-mode" "semanticdb-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-mode"
-;;;;;; "cedet/semantic/db-mode.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/db-mode.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-mode" '("semanticdb-")))
+(register-definition-prefixes "semantic/db-javascript" '("javascript-mode" "semanticdb-"))
;;;***
@@ -29200,23 +29115,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/db-ref.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-ref" '("semanticdb-ref-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/db-typecache"
-;;;;;; "cedet/semantic/db-typecache.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/db-typecache.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/db-typecache" '("semanticdb-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/debug"
-;;;;;; "cedet/semantic/debug.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/debug.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/debug" '("semantic-debug-")))
+(register-definition-prefixes "semantic/db-ref" '("semanticdb-ref-"))
;;;***
@@ -29224,39 +29123,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/decorate.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/decorate" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/decorate/include"
-;;;;;; "cedet/semantic/decorate/include.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/decorate/include.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/decorate/include" '("semantic-decoration-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/decorate/mode"
-;;;;;; "cedet/semantic/decorate/mode.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/decorate/mode.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/decorate/mode" '("define-semantic-decoration-style" "semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/dep"
-;;;;;; "cedet/semantic/dep.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/dep.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/dep" '("defcustom-mode-local-semantic-dependency-system-include-path" "semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/doc"
-;;;;;; "cedet/semantic/doc.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/doc.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/doc" '("semantic-doc")))
+(register-definition-prefixes "semantic/decorate" '("semantic-"))
;;;***
@@ -29264,31 +29131,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/ede-grammar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ede-grammar" '("semantic-ede-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/edit"
-;;;;;; "cedet/semantic/edit.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/edit.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/edit" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/find"
-;;;;;; "cedet/semantic/find.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/find.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/find" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/format"
-;;;;;; "cedet/semantic/format.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/format.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/format" '("semantic-")))
+(register-definition-prefixes "semantic/ede-grammar" '("semantic-ede-"))
;;;***
@@ -29296,7 +29139,7 @@ Major mode for editing Bovine grammars.
;;;;;; 0))
;;; Generated autoloads from cedet/semantic/fw.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/fw" '("semantic")))
+(register-definition-prefixes "semantic/fw" '("semantic"))
;;;***
@@ -29304,7 +29147,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/grammar.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/grammar" '("semantic-")))
+(register-definition-prefixes "semantic/grammar" '("semantic-"))
;;;***
@@ -29312,47 +29155,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/grammar-wy.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/grammar-wy" '("semantic-grammar-wy--")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/html"
-;;;;;; "cedet/semantic/html.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/html.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/html" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/ia"
-;;;;;; "cedet/semantic/ia.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/ia.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ia" '("semantic-ia-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/ia-sb"
-;;;;;; "cedet/semantic/ia-sb.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/ia-sb.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/ia-sb" '("semantic-ia-s")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/idle"
-;;;;;; "cedet/semantic/idle.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/idle.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/idle" '("define-semantic-idle-service" "global-semantic-idle-summary-mode" "semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/imenu"
-;;;;;; "cedet/semantic/imenu.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/imenu.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/imenu" '("semantic-")))
+(register-definition-prefixes "semantic/grammar-wy" '("semantic-grammar-wy--"))
;;;***
@@ -29360,31 +29163,7 @@ Major mode for editing Bovine grammars.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/semantic/java.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/java" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/lex"
-;;;;;; "cedet/semantic/lex.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/lex.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/lex" '("define-lex" "semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/lex-spp"
-;;;;;; "cedet/semantic/lex-spp.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/lex-spp.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/lex-spp" '("define-lex-spp-" "semantic-lex-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/mru-bookmark"
-;;;;;; "cedet/semantic/mru-bookmark.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/mru-bookmark.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/mru-bookmark" '("global-semantic-mru-bookmark-mode" "semantic-")))
+(register-definition-prefixes "semantic/java" '("semantic-"))
;;;***
@@ -29392,47 +29171,7 @@ Major mode for editing Bovine grammars.
;;;;;; 0))
;;; Generated autoloads from cedet/semantic/sb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/sb" '("semantic-sb-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/scope"
-;;;;;; "cedet/semantic/scope.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/scope.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/scope" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/senator"
-;;;;;; "cedet/semantic/senator.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/senator.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/senator" '("semantic-up-reference" "senator-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/sort"
-;;;;;; "cedet/semantic/sort.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/sort.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/sort" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref"
-;;;;;; "cedet/semantic/symref.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/symref.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref" '("semantic-symref-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/cscope"
-;;;;;; "cedet/semantic/symref/cscope.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/symref/cscope.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/cscope" '("semantic-symref-cscope--line-re")))
+(register-definition-prefixes "semantic/sb" '("semantic-sb-"))
;;;***
@@ -29440,79 +29179,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/symref/filter.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/filter" '("semantic-symref-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/global"
-;;;;;; "cedet/semantic/symref/global.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/symref/global.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/global" '("semantic-symref-global--line-re")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/grep"
-;;;;;; "cedet/semantic/symref/grep.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/symref/grep.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/grep" '("semantic-symref-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/idutils"
-;;;;;; "cedet/semantic/symref/idutils.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/symref/idutils.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/idutils" '("semantic-symref-idutils--line-re")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/symref/list"
-;;;;;; "cedet/semantic/symref/list.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/symref/list.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/symref/list" '("semantic-symref-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag"
-;;;;;; "cedet/semantic/tag.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/tag.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag-file"
-;;;;;; "cedet/semantic/tag-file.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/tag-file.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag-file" '("semantic-prototype-file")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag-ls"
-;;;;;; "cedet/semantic/tag-ls.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/tag-ls.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag-ls" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/tag-write"
-;;;;;; "cedet/semantic/tag-write.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/tag-write.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/tag-write" '("semantic-tag-write-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/texi"
-;;;;;; "cedet/semantic/texi.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/texi.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/texi" '("semantic-")))
+(register-definition-prefixes "semantic/symref/filter" '("semantic-symref-"))
;;;***
@@ -29520,15 +29187,7 @@ Major mode for editing Bovine grammars.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/semantic/util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/util" '("semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/util-modes"
-;;;;;; "cedet/semantic/util-modes.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/util-modes.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/util-modes" '("semantic-")))
+(register-definition-prefixes "semantic/util" '("semantic-"))
;;;***
@@ -29536,7 +29195,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/wisent.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent" '("define-wisent-lexer" "wisent-")))
+(register-definition-prefixes "semantic/wisent" '("define-wisent-lexer" "wisent-"))
;;;***
@@ -29544,7 +29203,7 @@ Major mode for editing Bovine grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/wisent/comp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/comp" '("wisent-")))
+(register-definition-prefixes "semantic/wisent/comp" '("wisent-"))
;;;***
@@ -29557,31 +29216,7 @@ Major mode for editing Wisent grammars.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/grammar" '("wisent-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/wisent/java-tags"
-;;;;;; "cedet/semantic/wisent/java-tags.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/wisent/java-tags.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/java-tags" '("semantic-" "wisent-java-parse-error")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/wisent/javascript"
-;;;;;; "cedet/semantic/wisent/javascript.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/wisent/javascript.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/javascript" '("semantic-" "wisent-javascript-jv-expand-tag")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "semantic/wisent/python"
-;;;;;; "cedet/semantic/wisent/python.el" (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/wisent/python.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/python" '("semantic-" "wisent-python-")))
+(register-definition-prefixes "semantic/wisent/grammar" '("wisent-"))
;;;***
@@ -29589,7 +29224,7 @@ Major mode for editing Wisent grammars.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/semantic/wisent/wisent.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "semantic/wisent/wisent" '("$action" "$nterm" "$region" "wisent-")))
+(register-definition-prefixes "semantic/wisent/wisent" '("$action" "$nterm" "$region" "wisent-"))
;;;***
@@ -29801,7 +29436,7 @@ and `default-sendmail-coding-system',
but lower priority than the local value of `buffer-file-coding-system'.
See also the function `select-message-coding-system'.")
-(defvar default-sendmail-coding-system 'iso-latin-1 "\
+(defvar default-sendmail-coding-system 'utf-8 "\
Default coding system for encoding the outgoing mail.
This variable is used only when `sendmail-coding-system' is nil.
@@ -29871,13 +29506,13 @@ Like `mail' command, but display mail buffer in another frame.
\(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER SENDACTIONS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sendmail" '("mail-" "sendmail-")))
+(register-definition-prefixes "sendmail" '("mail-" "sendmail-"))
;;;***
;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/seq.el
-(push (purecopy '(seq 2 21)) package--builtin-versions)
+(push (purecopy '(seq 2 22)) package--builtin-versions)
(autoload 'seq-take "seq" "\
Take the first N elements of SEQUENCE and return the result.
@@ -29919,6 +29554,11 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called.
\(fn FUNCTION SEQUENCE INITIAL-VALUE)" nil nil)
+(autoload 'seq-every-p "seq" "\
+Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE.
+
+\(fn PRED SEQUENCE)" nil nil)
+
(autoload 'seq-some "seq" "\
Return non-nil if PRED is satisfied for at least one element of SEQUENCE.
If so, return the first non-nil value returned by PRED.
@@ -29941,7 +29581,20 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil.
\(fn SEQUENCE ELT &optional TESTFN)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "seq" '("seq-")))
+(autoload 'seq-group-by "seq" "\
+Apply FUNCTION to each element of SEQUENCE.
+Separate the elements of SEQUENCE into an alist using the results as
+keys. Keys are compared using `equal'.
+
+\(fn FUNCTION SEQUENCE)" nil nil)
+
+(autoload 'seq-max "seq" "\
+Return the largest element of SEQUENCE.
+SEQUENCE must be a sequence of numbers or markers.
+
+\(fn SEQUENCE)" nil nil)
+
+(register-definition-prefixes "seq" '("seq-"))
;;;***
@@ -29996,10 +29649,16 @@ or call the function `server-mode'.")
(autoload 'server-mode "server" "\
Toggle Server mode.
-If called interactively, enable Server mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Server mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Server mode runs a process that accepts commands from the
`emacsclient' program. See Info node `Emacs server' and
@@ -30016,7 +29675,7 @@ only these files will be asked to be saved.
\(fn ARG)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "server" '("server-")))
+(register-definition-prefixes "server" '("server-"))
;;;***
@@ -30060,7 +29719,7 @@ These are active only in the minibuffer, when entering or editing a
formula:
\\{ses-mode-edit-map}" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ses" '("ses")))
+(register-definition-prefixes "ses" '("ses"))
;;;***
@@ -30109,7 +29768,7 @@ have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are
ignored unless the text is <pre>preformatted.</pre> Text can be marked as
-<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-o or
+<strong>bold</strong>, <em>italic</em> or <u>underlined</u> using the normal M-o or
Edit/Text Properties/Face commands.
Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
@@ -30128,14 +29787,13 @@ To work around that, do:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sgml-mode" '("html-" "sgml-")))
+(register-definition-prefixes "sgml-mode" '("html-" "sgml-"))
;;;***
;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from progmodes/sh-script.el
-(push (purecopy '(sh-script 2 0 6)) package--builtin-versions)
(put 'sh-shell 'safe-local-variable 'symbolp)
(autoload 'sh-mode "sh-script" "\
@@ -30167,11 +29825,9 @@ following commands are available, based on the current shell's syntax:
\\[sh-while] while loop
For sh and rc shells indentation commands are:
-\\[sh-show-indent] Show the variable controlling this line's indentation.
-\\[sh-set-indent] Set then variable controlling this line's indentation.
-\\[sh-learn-line-indent] Change the indentation variable so this line
-would indent to the way it currently is.
-\\[sh-learn-buffer-indent] Set the indentation variables so the
+\\[smie-config-show-indent] Show the rules controlling this line's indentation.
+\\[smie-config-set-indent] Change the rules controlling this line's indentation.
+\\[smie-config-guess] Try to tweak the indentation rules so the
buffer indents as it currently is indented.
@@ -30196,7 +29852,7 @@ with your script for an edit-interpret-debug cycle.
(defalias 'shell-script-mode 'sh-mode)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sh-script" '("sh-")))
+(register-definition-prefixes "sh-script" '("sh-"))
;;;***
@@ -30247,7 +29903,7 @@ function, `load-path-shadows-find'.
\(fn &optional STRINGP)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shadow" '("load-path-shadows-")))
+(register-definition-prefixes "shadow" '("load-path-shadows-"))
;;;***
@@ -30281,7 +29937,7 @@ function). Each site can be either a hostname or the name of a cluster (see
(autoload 'shadow-initialize "shadowfile" "\
Set up file shadowing." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shadowfile" '("shadow")))
+(register-definition-prefixes "shadowfile" '("shadow"))
;;;***
@@ -30333,7 +29989,20 @@ Make the shell buffer the current buffer, and return it.
\(fn &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shell" '("dirs" "explicit-" "shell-")))
+(register-definition-prefixes "shell" '("dirs" "explicit-" "shell-"))
+
+;;;***
+
+;;;### (autoloads nil "shortdoc" "emacs-lisp/shortdoc.el" (0 0 0
+;;;;;; 0))
+;;; Generated autoloads from emacs-lisp/shortdoc.el
+
+(autoload 'shortdoc-display-group "shortdoc" "\
+Pop to a buffer with short documentation summary for functions in GROUP.
+
+\(fn GROUP)" t nil)
+
+(register-definition-prefixes "shortdoc" '("alist" "buffer" "define-short-documentation-group" "file" "hash-table" "list" "number" "process" "regexp" "sequence" "shortdoc-" "string" "vector"))
;;;***
@@ -30352,14 +30021,14 @@ DOM should be a parse tree as generated by
\(fn DOM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shr" '("shr-" "svg--wrap-svg")))
+(register-definition-prefixes "shr" '("shr-"))
;;;***
;;;### (autoloads nil "shr-color" "net/shr-color.el" (0 0 0 0))
;;; Generated autoloads from net/shr-color.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "shr-color" '("shr-color-")))
+(register-definition-prefixes "shr-color" '("shr-color-"))
;;;***
@@ -30386,7 +30055,7 @@ DOM should be a parse tree as generated by
\(fn &optional NAME)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sieve" '("sieve-")))
+(register-definition-prefixes "sieve" '("sieve-"))
;;;***
@@ -30394,7 +30063,7 @@ DOM should be a parse tree as generated by
;;;;;; 0))
;;; Generated autoloads from net/sieve-manage.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sieve-manage" '("sieve-")))
+(register-definition-prefixes "sieve-manage" '("sieve-"))
;;;***
@@ -30411,7 +30080,7 @@ Turning on Sieve mode runs `sieve-mode-hook'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sieve-mode" '("sieve-")))
+(register-definition-prefixes "sieve-mode" '("sieve-"))
;;;***
@@ -30461,7 +30130,7 @@ with no arguments, if that value is non-nil.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "simula" '("simula-")))
+(register-definition-prefixes "simula" '("simula-"))
;;;***
@@ -30583,7 +30252,7 @@ twice for the others.
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "skeleton" '("skeleton-")))
+(register-definition-prefixes "skeleton" '("skeleton-"))
;;;***
@@ -30617,10 +30286,16 @@ buffer names.
(autoload 'smerge-mode "smerge-mode" "\
Minor mode to simplify editing output from the diff3 program.
-If called interactively, enable Smerge mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Smerge mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\\{smerge-mode-map}
@@ -30628,16 +30303,18 @@ enable the mode if ARG is omitted or nil, and toggle it if ARG is
(autoload 'smerge-start-session "smerge-mode" "\
Turn on `smerge-mode' and move point to first conflict marker.
-If no conflict maker is found, turn off `smerge-mode'." t nil)
+If no conflict maker is found, turn off `smerge-mode'.
+
+\(fn &optional INTERACTIVELY)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smerge-mode" '("smerge-")))
+(register-definition-prefixes "smerge-mode" '("smerge-"))
;;;***
;;;### (autoloads nil "smie" "emacs-lisp/smie.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/smie.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smie" '("smie-")))
+(register-definition-prefixes "smie" '("smie-"))
;;;***
@@ -30656,14 +30333,14 @@ interactively. If there's no argument, do it at the current buffer.
\(fn &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smiley" '("gnus-smiley-file-types" "smiley-")))
+(register-definition-prefixes "smiley" '("gnus-smiley-file-types" "smiley-"))
;;;***
;;;### (autoloads nil "smime" "gnus/smime.el" (0 0 0 0))
;;; Generated autoloads from gnus/smime.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smime" '("smime")))
+(register-definition-prefixes "smime" '("smime"))
;;;***
@@ -30675,7 +30352,7 @@ interactively. If there's no argument, do it at the current buffer.
(autoload 'smtpmail-send-queued-mail "smtpmail" "\
Send mail that was queued as a result of setting `smtpmail-queue-mail'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "smtpmail" '("smtpmail-")))
+(register-definition-prefixes "smtpmail" '("smtpmail-"))
;;;***
@@ -30698,7 +30375,7 @@ Snake mode keybindings:
\\[snake-move-up] Makes the snake move up
\\[snake-move-down] Makes the snake move down" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "snake" '("snake-")))
+(register-definition-prefixes "snake" '("snake-"))
;;;***
@@ -30725,7 +30402,7 @@ Delete converts tabs to spaces as it moves back.
Turning on snmp-mode runs the hooks in `snmp-common-mode-hook',
then `snmpv2-mode-hook'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "snmp-mode" '("snmp")))
+(register-definition-prefixes "snmp-mode" '("snmp"))
;;;***
@@ -30742,10 +30419,16 @@ Open the so-long `customize' group." t nil)
(autoload 'so-long-minor-mode "so-long" "\
This is the minor mode equivalent of `so-long-mode'.
-If called interactively, enable So-Long minor mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `So-Long minor mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Any active minor modes listed in `so-long-minor-modes' are disabled for the
current buffer, and buffer-local values are assigned to variables in accordance
@@ -30818,10 +30501,16 @@ or call the function `global-so-long-mode'.")
(autoload 'global-so-long-mode "so-long" "\
Toggle automated performance mitigations for files with long lines.
-If called interactively, enable Global So-Long mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Global So-Long mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Many Emacs modes struggle with buffers which contain excessively long lines,
and may consequently cause unacceptable performance issues.
@@ -30839,15 +30528,15 @@ Use \\[so-long-customize] to configure the behaviour.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "so-long" '("so-long-" "turn-o")))
+(register-definition-prefixes "so-long" '("so-long-" "turn-o"))
;;;***
;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0))
;;; Generated autoloads from net/soap-client.el
-(push (purecopy '(soap-client 3 1 5)) package--builtin-versions)
+(push (purecopy '(soap-client 3 2 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-client" '("soap-")))
+(register-definition-prefixes "soap-client" '("soap-"))
;;;***
@@ -30855,14 +30544,14 @@ Use \\[so-long-customize] to configure the behaviour.
;;;;;; 0))
;;; Generated autoloads from net/soap-inspect.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-inspect" '("soap-")))
+(register-definition-prefixes "soap-inspect" '("soap-"))
;;;***
;;;### (autoloads nil "socks" "net/socks.el" (0 0 0 0))
;;; Generated autoloads from net/socks.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "socks" '("socks-")))
+(register-definition-prefixes "socks" '("socks-"))
;;;***
@@ -30879,7 +30568,7 @@ This function is suitable for execution in an init file.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "solar" '("calendar-" "diary-sunrise-sunset" "solar-")))
+(register-definition-prefixes "solar" '("calendar-" "diary-sunrise-sunset" "solar-"))
;;;***
@@ -30956,7 +30645,7 @@ Pick your favorite shortcuts:
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "solitaire" '("solitaire-")))
+(register-definition-prefixes "solitaire" '("solitaire-"))
;;;***
@@ -31138,14 +30827,14 @@ is non-nil, it also prints a message describing the number of deletions.
\(fn BEG END &optional REVERSE ADJACENT KEEP-BLANKS INTERACTIVE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sort" '("sort-")))
+(register-definition-prefixes "sort" '("sort-"))
;;;***
;;;### (autoloads nil "soundex" "soundex.el" (0 0 0 0))
;;; Generated autoloads from soundex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soundex" '("soundex")))
+(register-definition-prefixes "soundex" '("soundex"))
;;;***
@@ -31161,7 +30850,7 @@ installed through `spam-necessary-extra-headers'.
\(fn &rest SYMBOLS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam" '("spam-")))
+(register-definition-prefixes "spam" '("spam-"))
;;;***
@@ -31202,21 +30891,21 @@ Remove spam-report support from the Agent.
Spam reports will be queued with the method used when
\\[spam-report-agentize] was run." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam-report" '("spam-report-")))
+(register-definition-prefixes "spam-report" '("spam-report-"))
;;;***
;;;### (autoloads nil "spam-stat" "gnus/spam-stat.el" (0 0 0 0))
;;; Generated autoloads from gnus/spam-stat.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam-stat" '("spam-stat" "with-spam-stat-max-buffer-size")))
+(register-definition-prefixes "spam-stat" '("spam-stat" "with-spam-stat-max-buffer-size"))
;;;***
;;;### (autoloads nil "spam-wash" "gnus/spam-wash.el" (0 0 0 0))
;;; Generated autoloads from gnus/spam-wash.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spam-wash" '("spam-")))
+(register-definition-prefixes "spam-wash" '("spam-"))
;;;***
@@ -31240,7 +30929,7 @@ Change frame focus to or from the speedbar frame.
If the selected frame is not speedbar, then speedbar frame is
selected. If the speedbar frame is active, then select the attached frame." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "speedbar" '("speedbar-")))
+(register-definition-prefixes "speedbar" '("speedbar-"))
;;;***
@@ -31253,7 +30942,7 @@ Adds that special touch of class to your outgoing mail." t nil)
(autoload 'snarf-spooks "spook" "\
Return a vector containing the lines from `spook-phrases-file'." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "spook" '("spook-phrase")))
+(register-definition-prefixes "spook" '("spook-phrase"))
;;;***
@@ -31308,7 +30997,7 @@ must tell Emacs. Here's how to do that in your init file:
\(add-hook \\='sql-mode-hook
(lambda ()
- (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))
+ (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))
\(fn)" t nil)
@@ -31753,7 +31442,7 @@ Run vsql as an inferior process.
\(fn &optional BUFFER)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sql" '("sql-")))
+(register-definition-prefixes "sql" '("sql-"))
;;;***
@@ -31761,7 +31450,7 @@ Run vsql as an inferior process.
;;; Generated autoloads from cedet/srecode.el
(push (purecopy '(srecode 1 2)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode" '("srecode-version")))
+(register-definition-prefixes "srecode" '("srecode-version"))
;;;***
@@ -31769,23 +31458,7 @@ Run vsql as an inferior process.
;;;;;; 0 0))
;;; Generated autoloads from cedet/srecode/args.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/args" '("srecode-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/compile"
-;;;;;; "cedet/srecode/compile.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/compile.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/compile" '("srecode-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/cpp"
-;;;;;; "cedet/srecode/cpp.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/cpp.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/cpp" '("srecode-")))
+(register-definition-prefixes "srecode/args" '("srecode-"))
;;;***
@@ -31793,7 +31466,7 @@ Run vsql as an inferior process.
;;;;;; 0 0))
;;; Generated autoloads from cedet/srecode/ctxt.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/ctxt" '("srecode-")))
+(register-definition-prefixes "srecode/ctxt" '("srecode-"))
;;;***
@@ -31801,31 +31474,7 @@ Run vsql as an inferior process.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/dictionary.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/dictionary" '("srecode-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/document"
-;;;;;; "cedet/srecode/document.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/document.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/document" '("srecode-document-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/el" "cedet/srecode/el.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/el.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/el" '("srecode-semantic-apply-tag-to-dict")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/expandproto"
-;;;;;; "cedet/srecode/expandproto.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/expandproto.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/expandproto" '("srecode-")))
+(register-definition-prefixes "srecode/dictionary" '("srecode-"))
;;;***
@@ -31833,7 +31482,7 @@ Run vsql as an inferior process.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/extract.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/extract" '("srecode-extract")))
+(register-definition-prefixes "srecode/extract" '("srecode-extract"))
;;;***
@@ -31841,7 +31490,7 @@ Run vsql as an inferior process.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/fields.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/fields" '("srecode-")))
+(register-definition-prefixes "srecode/fields" '("srecode-"))
;;;***
@@ -31849,7 +31498,7 @@ Run vsql as an inferior process.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/filters.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/filters" '("srecode-comment-prefix")))
+(register-definition-prefixes "srecode/filters" '("srecode-comment-prefix"))
;;;***
@@ -31857,39 +31506,7 @@ Run vsql as an inferior process.
;;;;;; 0 0))
;;; Generated autoloads from cedet/srecode/find.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/find" '("srecode-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/getset"
-;;;;;; "cedet/srecode/getset.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/getset.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/getset" '("srecode-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/insert"
-;;;;;; "cedet/srecode/insert.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/insert.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/insert" '("srecode-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/map"
-;;;;;; "cedet/srecode/map.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/map.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/map" '("srecode-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/mode"
-;;;;;; "cedet/srecode/mode.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/mode.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/mode" '("srecode-")))
+(register-definition-prefixes "srecode/find" '("srecode-"))
;;;***
@@ -31897,15 +31514,7 @@ Run vsql as an inferior process.
;;;;;; (0 0 0 0))
;;; Generated autoloads from cedet/srecode/semantic.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/semantic" '("srecode-semantic-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/srt"
-;;;;;; "cedet/srecode/srt.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/srt.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/srt" '("srecode-read-")))
+(register-definition-prefixes "srecode/semantic" '("srecode-semantic-"))
;;;***
@@ -31920,7 +31529,7 @@ Major-mode for writing SRecode macros.
(defalias 'srt-mode 'srecode-template-mode)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/srt-mode" '("semantic-" "srecode-")))
+(register-definition-prefixes "srecode/srt-mode" '("semantic-" "srecode-"))
;;;***
@@ -31928,23 +31537,7 @@ Major-mode for writing SRecode macros.
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/srecode/table.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/table" '("object-sort-list" "srecode-")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/template"
-;;;;;; "cedet/srecode/template.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/template.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/template" '("semantic-tag-components")))
-
-;;;***
-
-;;;### (autoloads "actual autoloads are elsewhere" "srecode/texi"
-;;;;;; "cedet/srecode/texi.el" (0 0 0 0))
-;;; Generated autoloads from cedet/srecode/texi.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "srecode/texi" '("semantic-insert-foreign-tag" "srecode-texi-")))
+(register-definition-prefixes "srecode/table" '("object-sort-list" "srecode-"))
;;;***
@@ -32026,10 +31619,16 @@ or call the function `strokes-mode'.")
(autoload 'strokes-mode "strokes" "\
Toggle Strokes mode, a global minor mode.
-If called interactively, enable Strokes mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Strokes mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\\<strokes-mode-map>
Strokes are pictographic mouse gestures which invoke commands.
@@ -32056,7 +31655,7 @@ Optional FORCE non-nil will ignore the buffer's read-only status.
(autoload 'strokes-compose-complex-stroke "strokes" "\
Read a complex stroke and insert its glyph into the current buffer." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "strokes" '("strokes-")))
+(register-definition-prefixes "strokes" '("strokes-"))
;;;***
@@ -32081,6 +31680,27 @@ Studlify-case the current buffer." t nil)
;;;### (autoloads nil "subr-x" "emacs-lisp/subr-x.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/subr-x.el
+(autoload 'if-let "subr-x" "\
+Bind variables according to SPEC and evaluate THEN or ELSE.
+Evaluate each binding in turn, as in `let*', stopping if a
+binding value is nil. If all are non-nil return the value of
+THEN, otherwise the last form in ELSE.
+
+Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
+SYMBOL to the value of VALUEFORM. An element can additionally be
+of the form (VALUEFORM), which is evaluated and checked for nil;
+i.e. SYMBOL can be omitted if only the test result is of
+interest. It can also be of the form SYMBOL, then the binding of
+SYMBOL is checked for nil.
+
+As a special case, interprets a SPEC of the form (SYMBOL SOMETHING)
+like ((SYMBOL SOMETHING)). This exists for backward compatibility
+with an old syntax that accepted only one binding.
+
+\(fn SPEC THEN &rest ELSE)" nil t)
+
+(function-put 'if-let 'lisp-indent-function '2)
+
(autoload 'when-let "subr-x" "\
Bind variables according to SPEC and conditionally evaluate BODY.
Evaluate each binding in turn, stopping if a binding value is nil.
@@ -32092,7 +31712,12 @@ The variable list SPEC is the same as in `if-let'.
(function-put 'when-let 'lisp-indent-function '1)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let" "internal--" "replace-region-contents" "string-" "thread-" "when-let*")))
+(autoload 'string-truncate-left "subr-x" "\
+Truncate STRING to LENGTH, replacing initial surplus with \"...\".
+
+\(fn STRING LENGTH)" nil nil)
+
+(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*" "internal--" "replace-region-contents" "string-" "thread-" "when-let*"))
;;;***
@@ -32104,10 +31729,16 @@ The variable list SPEC is the same as in `if-let'.
(autoload 'subword-mode "subword" "\
Toggle subword movement and editing (Subword mode).
-If called interactively, enable Subword mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Subword mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Subword mode is a buffer-local minor mode. Enabling it changes
the definition of a word so that word-based commands stop inside
@@ -32149,17 +31780,25 @@ ARG is omitted or nil.
Subword mode is enabled in all buffers where
`(lambda nil (subword-mode 1))' would do it.
-See `subword-mode' for more information on Subword mode.
+
+See `subword-mode' for more information on
+Subword mode.
\(fn &optional ARG)" t nil)
(autoload 'superword-mode "subword" "\
Toggle superword movement and editing (Superword mode).
-If called interactively, enable Superword mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Superword mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Superword mode is a buffer-local minor mode. Enabling it changes
the definition of words such that symbols characters are treated
@@ -32190,11 +31829,13 @@ ARG is omitted or nil.
Superword mode is enabled in all buffers where
`(lambda nil (superword-mode 1))' would do it.
-See `superword-mode' for more information on Superword mode.
+
+See `superword-mode' for more information on
+Superword mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "subword" '("subword-" "superword-mode-map")))
+(register-definition-prefixes "subword" '("subword-" "superword-mode-map"))
;;;***
@@ -32226,23 +31867,21 @@ The region need not be active (and typically isn't when this
function is called). Also, the hook `sc-pre-hook' is run before,
and `sc-post-hook' is run after the guts of this function." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "supercite" '("sc-")))
+(register-definition-prefixes "supercite" '("sc-"))
;;;***
;;;### (autoloads nil "svg" "svg.el" (0 0 0 0))
;;; Generated autoloads from svg.el
-(push (purecopy '(svg 1 0)) package--builtin-versions)
+(push (purecopy '(svg 1 1)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "svg" '("svg-")))
+(register-definition-prefixes "svg" '("svg-"))
;;;***
;;;### (autoloads nil "t-mouse" "t-mouse.el" (0 0 0 0))
;;; Generated autoloads from t-mouse.el
-(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1")
-
(defvar gpm-mouse-mode t "\
Non-nil if Gpm-Mouse mode is enabled.
See the `gpm-mouse-mode' command
@@ -32256,10 +31895,16 @@ or call the function `gpm-mouse-mode'.")
(autoload 'gpm-mouse-mode "t-mouse" "\
Toggle mouse support in GNU/Linux consoles (GPM Mouse mode).
-If called interactively, enable Gpm-Mouse mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Gpm-Mouse mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
This allows the use of the mouse when operating on a GNU/Linux console,
in the same way as you can use the mouse under X11.
@@ -32271,7 +31916,7 @@ GPM. This is due to limitations in GPM and the Linux kernel.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "t-mouse" '("gpm-mouse-")))
+(register-definition-prefixes "t-mouse" '("gpm-mouse-"))
;;;***
@@ -32281,10 +31926,16 @@ GPM. This is due to limitations in GPM and the Linux kernel.
(autoload 'tab-line-mode "tab-line" "\
Toggle display of window tab line in the buffer.
-If called interactively, enable Tab-Line mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Tab-Line mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
@@ -32312,11 +31963,13 @@ ARG is omitted or nil.
Tab-Line mode is enabled in all buffers where
`tab-line-mode--turn-on' would do it.
-See `tab-line-mode' for more information on Tab-Line mode.
+
+See `tab-line-mode' for more information on
+Tab-Line mode.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tab-line" '("tab-line-")))
+(register-definition-prefixes "tab-line" '("tab-line-"))
;;;***
@@ -32347,7 +32000,7 @@ The variable `tab-width' controls the spacing of tab stops.
\(fn START END &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tabify" '("tabify-regexp")))
+(register-definition-prefixes "tabify" '("tabify-regexp"))
;;;***
@@ -32689,10 +32342,16 @@ location is indicated by `table-word-continuation-char'. This
variable's value can be toggled by \\[table-fixed-width-mode] at
run-time.
-If called interactively, enable Table-Fixed-Width mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Table-Fixed-Width mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
@@ -32728,7 +32387,7 @@ buffer, and leaves the previous contents of the buffer untouched.
References used for this implementation:
HTML:
- URL `http://www.w3.org'
+ URL `https://www.w3.org'
LaTeX:
URL `http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html'
@@ -32911,7 +32570,7 @@ Remove the frame from a table and deactivate the table. This command
converts a table into plain text without frames. It is a companion to
`table-capture' which does the opposite process." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "table" '("*table--" "table-")))
+(register-definition-prefixes "table" '("*table--" "table-"))
;;;***
@@ -32933,7 +32592,7 @@ Connect to display DISPLAY for the Emacs talk group.
(autoload 'talk "talk" "\
Connect to the Emacs talk group from the current X display or tty frame." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "talk" '("talk-")))
+(register-definition-prefixes "talk" '("talk-"))
;;;***
@@ -32958,7 +32617,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tar-mode" '("tar-")))
+(register-definition-prefixes "tar-mode" '("tar-"))
;;;***
@@ -33008,7 +32667,7 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'.
\(fn COMMAND &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tcl" '("add-log-tcl-defun" "calculate-tcl-indent" "indent-tcl-exp" "inferior-tcl-" "run-tcl" "switch-to-tcl" "tcl-")))
+(register-definition-prefixes "tcl" '("inferior-tcl-" "run-tcl" "switch-to-tcl" "tcl-"))
;;;***
@@ -33016,15 +32675,7 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'.
;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/tcover-ses.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tcover-ses" '("ses-exercise")))
-
-;;;***
-
-;;;### (autoloads nil "tcover-unsafep" "emacs-lisp/tcover-unsafep.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/tcover-unsafep.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tcover-unsafep" '("testcover-unsafep")))
+(register-definition-prefixes "tcover-ses" '("ses-exercise"))
;;;***
@@ -33051,14 +32702,14 @@ Normally input is edited in Emacs and sent a line at a time.
\(fn HOST)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "telnet" '("send-process-next-char" "telnet-")))
+(register-definition-prefixes "telnet" '("send-process-next-char" "telnet-"))
;;;***
;;;### (autoloads nil "tempo" "tempo.el" (0 0 0 0))
;;; Generated autoloads from tempo.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tempo" '("tempo-")))
+(register-definition-prefixes "tempo" '("tempo-"))
;;;***
@@ -33111,7 +32762,7 @@ use in that buffer.
\(fn PORT SPEED &optional LINE-MODE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "term" '("ansi-term-color-vector" "explicit-shell-file-name" "serial-" "term-")))
+(register-definition-prefixes "term" '("ansi-term-color-vector" "explicit-shell-file-name" "serial-" "term-"))
;;;***
@@ -33128,7 +32779,7 @@ If BYTE-COMPILE is non-nil, byte compile each function after instrumenting.
(autoload 'testcover-this-defun "testcover" "\
Start coverage on function under point." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "testcover" '("testcover-")))
+(register-definition-prefixes "testcover" '("testcover-"))
;;;***
@@ -33155,7 +32806,7 @@ tetris-mode keybindings:
" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tetris" '("tetris-")))
+(register-definition-prefixes "tetris" '("tetris-"))
;;;***
@@ -33284,7 +32935,7 @@ Should show the queue(s) that \\[tex-print] puts jobs on.")
(custom-autoload 'tex-show-queue-command "tex-mode" t)
-(defvar tex-default-mode 'latex-mode "\
+(defvar tex-default-mode #'latex-mode "\
Mode to enter for a new file that might be either TeX or LaTeX.
This variable is used when it can't be determined whether the file
is plain TeX or LaTeX or what because the file contains no commands.
@@ -33304,11 +32955,14 @@ String inserted by typing \\[tex-insert-quote] to close a quotation.")
(autoload 'tex-mode "tex-mode" "\
Major mode for editing files of input for TeX, LaTeX, or SliTeX.
+This is the shared parent mode of several submodes.
Tries to determine (by looking at the beginning of the file) whether
this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode',
-`latex-mode', or `slitex-mode', respectively. If it cannot be determined,
+`latex-mode', or `slitex-mode', accordingly. If it cannot be determined,
such as if there are no commands in the file, the value of `tex-default-mode'
-says which mode to use." t nil)
+says which mode to use.
+
+\(fn)" t nil)
(defalias 'TeX-mode 'tex-mode)
@@ -33453,7 +33107,7 @@ Major mode to edit DocTeX files.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tex-mode" '("doctex-font-lock-" "latex-" "plain-tex-mode-map" "tex-")))
+(register-definition-prefixes "tex-mode" '("doctex-font-lock-" "latex-" "plain-tex-mode-map" "tex-"))
;;;***
@@ -33494,7 +33148,7 @@ if large. You can use `Info-split' to do this manually.
\(fn &optional NOSPLIT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "texinfmt" '("batch-texinfo-format" "texinf")))
+(register-definition-prefixes "texinfmt" '("batch-texinfo-format" "texinf"))
;;;***
@@ -33580,7 +33234,7 @@ value of `texinfo-mode-hook'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "texinfo" '("texinfo-")))
+(register-definition-prefixes "texinfo" '("texinfo-"))
;;;***
@@ -33588,7 +33242,7 @@ value of `texinfo-mode-hook'.
;;;;;; 0 0))
;;; Generated autoloads from textmodes/texnfo-upd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "texnfo-upd" '("texinfo-")))
+(register-definition-prefixes "texnfo-upd" '("texinfo-"))
;;;***
@@ -33596,7 +33250,7 @@ value of `texinfo-mode-hook'.
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/text-property-search.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "text-property-search" '("text-property-")))
+(register-definition-prefixes "text-property-search" '("text-property-"))
;;;***
@@ -33624,7 +33278,7 @@ Compose Thai characters in the current buffer." t nil)
\(fn GSTRING DIRECTION)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thai-util" '("exit-thai-language-environment-internal" "setup-thai-language-environment-internal" "thai-")))
+(register-definition-prefixes "thai-util" '("exit-thai-language-environment-internal" "setup-thai-language-environment-internal" "thai-"))
;;;***
@@ -33632,7 +33286,7 @@ Compose Thai characters in the current buffer." t nil)
;;;;;; 0))
;;; Generated autoloads from language/thai-word.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thai-word" '("thai-")))
+(register-definition-prefixes "thai-word" '("thai-"))
;;;***
@@ -33696,7 +33350,7 @@ treated as white space.
\(fn &optional IGNORE-COMMENT-OR-STRING)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thingatpt" '("beginning-of-thing" "define-thing-chars" "end-of-thing" "filename" "form-at-point" "in-string-p" "sentence-at-point" "thing-at-point-" "word-at-point")))
+(register-definition-prefixes "thingatpt" '("beginning-of-thing" "define-thing-chars" "end-of-thing" "filename" "form-at-point" "in-string-p" "sentence-at-point" "thing-at-point-" "word-at-point"))
;;;***
@@ -33714,7 +33368,7 @@ An EVENT has the format
Display a list of threads." t nil)
(put 'list-threads 'disabled "Beware: manually canceling threads can ruin your Emacs session.")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thread" '("thread-list-")))
+(register-definition-prefixes "thread" '("thread-list-"))
;;;***
@@ -33744,7 +33398,7 @@ In dired, make a thumbs buffer with all files in current directory." t nil)
(autoload 'thumbs-dired-setroot "thumbs" "\
In dired, call the setroot program on the image at point." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thumbs" '("thumbs-")))
+(register-definition-prefixes "thumbs" '("thumbs-"))
;;;***
@@ -33752,7 +33406,7 @@ In dired, call the setroot program on the image at point." t nil)
;;; Generated autoloads from emacs-lisp/thunk.el
(push (purecopy '(thunk 1 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thunk" '("thunk-")))
+(register-definition-prefixes "thunk" '("thunk-"))
;;;***
@@ -33824,7 +33478,7 @@ See also docstring of the function tibetan-compose-region." t nil)
\(fn FROM TO)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tibet-util" '("tibetan-")))
+(register-definition-prefixes "tibet-util" '("tibetan-"))
;;;***
@@ -33879,10 +33533,16 @@ This function is meant to be used as a `post-self-insert-hook'." t nil)
(autoload 'tildify-mode "tildify" "\
Adds electric behavior to space character.
-If called interactively, enable Tildify mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Tildify mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When space is inserted into a buffer in a position where hard space is required
instead (determined by `tildify-space-pattern' and `tildify-space-predicates'),
@@ -33895,7 +33555,7 @@ variable will be set to the representation.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tildify" '("tildify-")))
+(register-definition-prefixes "tildify" '("tildify-"))
;;;***
@@ -33928,10 +33588,16 @@ or call the function `display-time-mode'.")
(autoload 'display-time-mode "time" "\
Toggle display of time, load level, and mail flag in mode lines.
-If called interactively, enable Display-Time mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Display-Time mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When Display Time mode is enabled, it updates every minute (you
can control the number of seconds between updates by customizing
@@ -33941,22 +33607,26 @@ runs the normal hook `display-time-hook' after each update.
\(fn &optional ARG)" t nil)
-(autoload 'display-time-world "time" "\
-Enable updating display of times in various time zones.
-`display-time-world-list' specifies the zones.
-To turn off the world time display, go to that window and type `q'." t nil)
+(define-obsolete-function-alias 'display-time-world #'world-clock "28.1")
+
+(autoload 'world-clock "time" "\
+Display a world clock buffer with times in various time zones.
+The variable `world-clock-list' specifies which time zones to use.
+To turn off the world time display, go to the window and type `\\[quit-window]'." t nil)
(autoload 'emacs-uptime "time" "\
Return a string giving the uptime of this instance of Emacs.
FORMAT is a string to format the result, using `format-seconds'.
For example, the Unix uptime command format is \"%D, %z%2h:%.2m\".
+If the optional argument HERE is non-nil, insert string at
+point.
-\(fn &optional FORMAT)" t nil)
+\(fn &optional FORMAT HERE)" t nil)
(autoload 'emacs-init-time "time" "\
Return a string giving the duration of the Emacs initialization." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time" '("display-time-" "legacy-style-world-list" "time--display-world-list" "zoneinfo-style-world-list")))
+(register-definition-prefixes "time" '("display-time-" "legacy-style-world-list" "time--display-world-list" "world-clock-" "zoneinfo-style-world-list"))
;;;***
@@ -34042,6 +33712,10 @@ Lower-case specifiers return only the unit.
optional leading \".\" for zero-padding. For example, \"%.3Y\" will
return something of the form \"001 year\".
+The \"%s\" spec takes an additional optional parameter,
+introduced by the \",\" character, to say how many decimals to
+use. \"%,1s\" means \"use one decimal\".
+
The \"%z\" specifier does not print anything. When it is used, specifiers
must be given in order of decreasing size. To the left of \"%z\", nothing
is output until the first non-zero unit is encountered.
@@ -34053,7 +33727,7 @@ Convert the time interval in seconds to a short string.
\(fn DELAY)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time-date" '("date-" "decoded-time-" "encode-time-value" "seconds-to-string" "time-" "with-decoded-time-value")))
+(register-definition-prefixes "time-date" '("date-" "decoded-time-" "encode-time-value" "seconds-to-string" "time-" "with-decoded-time-value"))
;;;***
@@ -34101,14 +33775,13 @@ With ARG, turn time stamping on if and only if arg is positive.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time-stamp" '("time-stamp-")))
+(register-definition-prefixes "time-stamp" '("time-stamp-"))
;;;***
;;;### (autoloads nil "timeclock" "calendar/timeclock.el" (0 0 0
;;;;;; 0))
;;; Generated autoloads from calendar/timeclock.el
-(push (purecopy '(timeclock 2 6 1)) package--builtin-versions)
(defvar timeclock-mode-line-display nil "\
Non-nil if Timeclock-Mode-Line-Display mode is enabled.
@@ -34210,7 +33883,7 @@ relative only to the time worked today, and not to past time.
\(fn &optional SHOW-SECONDS TODAY-ONLY)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "timeclock" '("timeclock-")))
+(register-definition-prefixes "timeclock" '("timeclock-"))
;;;***
@@ -34224,14 +33897,14 @@ List all timers in a buffer.
\(fn &optional IGNORE-AUTO NONCONFIRM)" t nil)
(put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "timer-list" '("timer-list-")))
+(register-definition-prefixes "timer-list" '("timer-list-"))
;;;***
;;;### (autoloads nil "timezone" "timezone.el" (0 0 0 0))
;;; Generated autoloads from timezone.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "timezone" '("timezone-")))
+(register-definition-prefixes "timezone" '("timezone-"))
;;;***
@@ -34256,14 +33929,13 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\".
\(fn &optional FORCE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "titdic-cnv" '("batch-miscdic-convert" "ctlau-" "miscdic-convert" "pinyin-convert" "py-converter" "quail-" "quick-" "tit-" "tsang-" "ziranma-converter")))
+(register-definition-prefixes "titdic-cnv" '("batch-miscdic-convert" "ctlau-" "miscdic-convert" "pinyin-convert" "py-converter" "quail-" "quick-" "tit-" "tsang-" "ziranma-converter"))
;;;***
;;;### (autoloads nil "tmm" "tmm.el" (0 0 0 0))
;;; Generated autoloads from tmm.el
(define-key global-map "\M-`" 'tmm-menubar)
- (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse)
(autoload 'tmm-menubar "tmm" "\
Text-mode emulation of looking and choosing from a menubar.
@@ -34302,7 +33974,7 @@ instead of executing it.
\(fn MENU &optional IN-POPUP DEFAULT-ITEM NO-EXECUTE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tmm" '("tmm-")))
+(register-definition-prefixes "tmm" '("tmm-"))
;;;***
@@ -34370,7 +34042,7 @@ Mode for displaying and reprioritizing top priority Todo.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "todo-mode" '("todo-")))
+(register-definition-prefixes "todo-mode" '("todo-"))
;;;***
@@ -34442,14 +34114,14 @@ holds a keymap.
\(fn COMMAND ICON IN-MAP &optional FROM-MAP &rest PROPS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tool-bar" '("tool-bar-")))
+(register-definition-prefixes "tool-bar" '("tool-bar-"))
;;;***
;;;### (autoloads nil "tooltip" "tooltip.el" (0 0 0 0))
;;; Generated autoloads from tooltip.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tooltip" '("tooltip-")))
+(register-definition-prefixes "tooltip" '("tooltip-"))
;;;***
@@ -34464,7 +34136,7 @@ to a tcp server on another machine.
\(fn PROCESS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tq" '("tq-")))
+(register-definition-prefixes "tq" '("tq-"))
;;;***
@@ -34513,13 +34185,13 @@ the output buffer or changing the window configuration.
(defalias 'trace-function 'trace-function-foreground)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trace" '("inhibit-trace" "trace-" "untrace-")))
+(register-definition-prefixes "trace" '("inhibit-trace" "trace-" "untrace-"))
;;;***
;;;### (autoloads nil "tramp" "net/tramp.el" (0 0 0 0))
;;; Generated autoloads from net/tramp.el
-(push (purecopy '(tramp 2 4 5 -1)) package--builtin-versions)
+(push (purecopy '(tramp 2 5 0 -1)) package--builtin-versions)
(defvar tramp-mode t "\
Whether Tramp is enabled.
@@ -34549,29 +34221,26 @@ match file names at root of the underlying local file system,
like \"/sys\" or \"/C:\".")
(defun tramp-autoload-file-name-handler (operation &rest args) "\
-Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (if tramp-mode (let ((default-directory temporary-file-directory)) (load "tramp" 'noerror 'nomessage))) (apply operation args))
+Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (when tramp-mode (let ((default-directory temporary-file-directory)) (load "tramp" 'noerror 'nomessage))) (apply operation args))
(defun tramp-register-autoload-file-name-handlers nil "\
-Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp 'tramp-autoload-file-name-handler)) (put 'tramp-autoload-file-name-handler 'safe-magic t))
+Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp 'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t))
(tramp-register-autoload-file-name-handlers)
(defun tramp-unload-file-name-handlers nil "\
Unload Tramp file name handlers from `file-name-handler-alist'." (dolist (fnh file-name-handler-alist) (when (and (symbolp (cdr fnh)) (string-prefix-p "tramp-" (symbol-name (cdr fnh)))) (setq file-name-handler-alist (delq fnh file-name-handler-alist)))))
-(defvar tramp-completion-mode nil "\
-If non-nil, external packages signal that they are in file name completion.")
-
(defun tramp-unload-tramp nil "\
Discard Tramp from loading remote files." (interactive) (ignore-errors (unload-feature 'tramp 'force)))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp" '("tramp-" "with-")))
+(register-definition-prefixes "tramp" '("tramp-" "with-"))
;;;***
;;;### (autoloads nil "tramp-adb" "net/tramp-adb.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-adb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-adb" '("tramp-")))
+(register-definition-prefixes "tramp-adb" '("tramp-"))
;;;***
@@ -34596,27 +34265,27 @@ Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\."
(defalias 'tramp-archive-autoload-file-name-handler #'tramp-autoload-file-name-handler)
(defun tramp-register-archive-file-name-handler nil "\
-Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put 'tramp-archive-autoload-file-name-handler 'safe-magic t)))
+Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put #'tramp-archive-autoload-file-name-handler 'safe-magic t)))
(add-hook 'after-init-hook #'tramp-register-archive-file-name-handler)
(add-hook 'tramp-archive-unload-hook (lambda nil (remove-hook 'after-init-hook #'tramp-register-archive-file-name-handler)))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-archive" '("tramp-" "with-parsed-tramp-archive-file-name")))
+(register-definition-prefixes "tramp-archive" '("tramp-" "with-parsed-tramp-archive-file-name"))
;;;***
;;;### (autoloads nil "tramp-cache" "net/tramp-cache.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-cache.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-cache" '("tramp-")))
+(register-definition-prefixes "tramp-cache" '("tramp-"))
;;;***
;;;### (autoloads nil "tramp-cmds" "net/tramp-cmds.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-cmds.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-cmds" '("tramp-")))
+(register-definition-prefixes "tramp-cmds" '("tramp-"))
;;;***
@@ -34624,21 +34293,28 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;;;; 0))
;;; Generated autoloads from net/tramp-compat.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-compat" '("tramp-")))
+(register-definition-prefixes "tramp-compat" '("tramp-"))
+
+;;;***
+
+;;;### (autoloads nil "tramp-crypt" "net/tramp-crypt.el" (0 0 0 0))
+;;; Generated autoloads from net/tramp-crypt.el
+
+(register-definition-prefixes "tramp-crypt" '("tramp-crypt-"))
;;;***
;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-ftp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-ftp" '("tramp-")))
+(register-definition-prefixes "tramp-ftp" '("tramp-"))
;;;***
;;;### (autoloads nil "tramp-gvfs" "net/tramp-gvfs.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-gvfs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-gvfs" '("tramp-" "with-tramp-dbus-")))
+(register-definition-prefixes "tramp-gvfs" '("tramp-" "with-tramp-dbus-"))
;;;***
@@ -34646,7 +34322,7 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;;;; (0 0 0 0))
;;; Generated autoloads from net/tramp-integration.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-integration" '("tramp-")))
+(register-definition-prefixes "tramp-integration" '("tramp-"))
;;;***
@@ -34654,21 +34330,21 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;;;; 0))
;;; Generated autoloads from net/tramp-rclone.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-rclone" '("tramp-rclone-")))
+(register-definition-prefixes "tramp-rclone" '("tramp-rclone-"))
;;;***
;;;### (autoloads nil "tramp-sh" "net/tramp-sh.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-sh.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-sh" '("tramp-")))
+(register-definition-prefixes "tramp-sh" '("tramp-"))
;;;***
;;;### (autoloads nil "tramp-smb" "net/tramp-smb.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-smb.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-smb" '("tramp-smb-")))
+(register-definition-prefixes "tramp-smb" '("tramp-smb-"))
;;;***
@@ -34676,28 +34352,28 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;;;; 0 0 0))
;;; Generated autoloads from net/tramp-sudoedit.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-sudoedit" '("tramp-sudoedit-")))
+(register-definition-prefixes "tramp-sudoedit" '("tramp-sudoedit-"))
;;;***
;;;### (autoloads nil "tramp-uu" "net/tramp-uu.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-uu.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tramp-uu" '("tramp-uu")))
+(register-definition-prefixes "tramp-uu" '("tramp-uu"))
;;;***
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-")))
+(register-definition-prefixes "trampver" '("tramp-"))
;;;***
;;;### (autoloads nil "tree-widget" "tree-widget.el" (0 0 0 0))
;;; Generated autoloads from tree-widget.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tree-widget" '("tree-widget-")))
+(register-definition-prefixes "tree-widget" '("tree-widget-"))
;;;***
@@ -34723,7 +34399,7 @@ resumed later.
\(fn &optional ARG DONT-ASK-FOR-REVERT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tutorial" '("get-lang-string" "lang-strings" "tutorial--")))
+(register-definition-prefixes "tutorial" '("get-lang-string" "lang-strings" "tutorial--"))
;;;***
@@ -34735,7 +34411,7 @@ resumed later.
\(fn FROM TO FONT-OBJECT STRING DIRECTION)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "tv-util" '("tai-viet-")))
+(register-definition-prefixes "tv-util" '("tai-viet-"))
;;;***
@@ -34783,7 +34459,7 @@ First column's text sSs Second column's text
\(fn ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "two-column" '("2C-")))
+(register-definition-prefixes "two-column" '("2C-"))
;;;***
@@ -34804,10 +34480,16 @@ or call the function `type-break-mode'.")
Enable or disable typing-break mode.
This is a minor mode, but it is global to all buffers by default.
-If called interactively, enable Type-Break mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Type-Break mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When this mode is enabled, the user is encouraged to take typing breaks at
appropriate intervals; either after a specified amount of time or when the
@@ -34916,7 +34598,7 @@ FRAC should be the inverse of the fractional value; for example, a value of
\(fn WPM &optional WORDLEN FRAC)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "type-break" '("timep" "type-break-")))
+(register-definition-prefixes "type-break" '("timep" "type-break-"))
;;;***
@@ -34931,7 +34613,7 @@ You might need to set `uce-mail-reader' before using this.
\(fn &optional IGNORED)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "uce" '("uce-")))
+(register-definition-prefixes "uce" '("uce-"))
;;;***
@@ -34999,7 +34681,7 @@ Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus.
\(fn STR)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ucs-normalize" '("ucs-normalize-" "utf-8-hfs")))
+(register-definition-prefixes "ucs-normalize" '("ucs-normalize-" "utf-8-hfs"))
;;;***
@@ -35024,14 +34706,6 @@ which specify the range to operate on.
;;;***
-;;;### (autoloads "actual autoloads are elsewhere" "undigest" "mail/undigest.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from mail/undigest.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "undigest" '("rmail-")))
-
-;;;***
-
;;;### (autoloads nil "unrmail" "mail/unrmail.el" (0 0 0 0))
;;; Generated autoloads from mail/unrmail.el
@@ -35048,7 +34722,7 @@ The variable `unrmail-mbox-format' controls which mbox format to use.
\(fn FILE TO-FILE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "unrmail" '("unrmail-mbox-format")))
+(register-definition-prefixes "unrmail" '("unrmail-mbox-format"))
;;;***
@@ -35062,7 +34736,7 @@ UNSAFEP-VARS is a list of symbols with local bindings.
\(fn FORM &optional UNSAFEP-VARS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "unsafep" '("safe-functions" "unsafep-")))
+(register-definition-prefixes "unsafep" '("safe-functions" "unsafep-"))
;;;***
@@ -35118,14 +34792,14 @@ how long to wait for a response before giving up.
\(fn URL &optional SILENT INHIBIT-COOKIES TIMEOUT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url" '("url-")))
+(register-definition-prefixes "url" '("url-"))
;;;***
;;;### (autoloads nil "url-about" "url/url-about.el" (0 0 0 0))
;;; Generated autoloads from url/url-about.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-about" '("url-")))
+(register-definition-prefixes "url-about" '("url-"))
;;;***
@@ -35168,7 +34842,7 @@ RATING a rating between 1 and 10 of the strength of the authentication.
\(fn TYPE &optional FUNCTION RATING)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-auth" '("url-")))
+(register-definition-prefixes "url-auth" '("url-"))
;;;***
@@ -35191,7 +34865,7 @@ Extract FNAM from the local disk cache.
\(fn FNAM)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-cache" '("url-")))
+(register-definition-prefixes "url-cache" '("url-"))
;;;***
@@ -35203,14 +34877,14 @@ Extract FNAM from the local disk cache.
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-cid" '("url-cid-gnus")))
+(register-definition-prefixes "url-cid" '("url-cid-gnus"))
;;;***
;;;### (autoloads nil "url-cookie" "url/url-cookie.el" (0 0 0 0))
;;; Generated autoloads from url/url-cookie.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-cookie" '("url-cookie")))
+(register-definition-prefixes "url-cookie" '("url-cookie"))
;;;***
@@ -35246,28 +34920,28 @@ added to this list, so most requests can just pass in nil.
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-dav" '("url-")))
+(register-definition-prefixes "url-dav" '("url-"))
;;;***
;;;### (autoloads nil "url-dired" "url/url-dired.el" (0 0 0 0))
;;; Generated autoloads from url/url-dired.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-dired" '("url-")))
+(register-definition-prefixes "url-dired" '("url-"))
;;;***
;;;### (autoloads nil "url-domsuf" "url/url-domsuf.el" (0 0 0 0))
;;; Generated autoloads from url/url-domsuf.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-domsuf" '("url-domsuf-")))
+(register-definition-prefixes "url-domsuf" '("url-domsuf-"))
;;;***
;;;### (autoloads nil "url-expand" "url/url-expand.el" (0 0 0 0))
;;; Generated autoloads from url/url-expand.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-expand" '("url-")))
+(register-definition-prefixes "url-expand" '("url-"))
;;;***
@@ -35279,21 +34953,21 @@ Handle file: and ftp: URLs.
\(fn URL CALLBACK CBARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-file" '("url-file-")))
+(register-definition-prefixes "url-file" '("url-file-"))
;;;***
;;;### (autoloads nil "url-ftp" "url/url-ftp.el" (0 0 0 0))
;;; Generated autoloads from url/url-ftp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-ftp" '("url-ftp")))
+(register-definition-prefixes "url-ftp" '("url-ftp"))
;;;***
;;;### (autoloads nil "url-future" "url/url-future.el" (0 0 0 0))
;;; Generated autoloads from url/url-future.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-future" '("url-future-")))
+(register-definition-prefixes "url-future" '("url-future-"))
;;;***
@@ -35316,7 +34990,7 @@ overriding the value of `url-gateway-method'.
\(fn NAME BUFFER HOST SERVICE &optional GATEWAY-METHOD)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-gw" '("url-")))
+(register-definition-prefixes "url-gw" '("url-"))
;;;***
@@ -35337,10 +35011,16 @@ or call the function `url-handler-mode'.")
(autoload 'url-handler-mode "url-handlers" "\
Toggle using `url' library for URL filenames (URL Handler mode).
-If called interactively, enable Url-Handler mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Url-Handler mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
@@ -35379,14 +35059,14 @@ if it had been inserted from a file named URL.
\(fn URL &optional VISIT BEG END REPLACE)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-handlers" '("url-")))
+(register-definition-prefixes "url-handlers" '("url-"))
;;;***
;;;### (autoloads nil "url-history" "url/url-history.el" (0 0 0 0))
;;; Generated autoloads from url/url-history.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-history" '("url-")))
+(register-definition-prefixes "url-history" '("url-"))
;;;***
@@ -35400,14 +35080,14 @@ if it had been inserted from a file named URL.
(autoload 'url-https-file-readable-p "url-http")
(autoload 'url-https-file-attributes "url-http")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-http" '("url-h")))
+(register-definition-prefixes "url-http" '("url-h"))
;;;***
;;;### (autoloads nil "url-imap" "url/url-imap.el" (0 0 0 0))
;;; Generated autoloads from url/url-imap.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-imap" '("url-imap")))
+(register-definition-prefixes "url-imap" '("url-imap"))
;;;***
@@ -35419,7 +35099,7 @@ if it had been inserted from a file named URL.
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-irc" '("url-irc-")))
+(register-definition-prefixes "url-irc" '("url-irc-"))
;;;***
@@ -35434,7 +35114,7 @@ URL can be a URL string, or a URL record of the type returned by
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-ldap" '("url-ldap-")))
+(register-definition-prefixes "url-ldap" '("url-ldap-"))
;;;***
@@ -35451,14 +35131,14 @@ Handle the mailto: URL syntax.
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-mailto" '("url-mail-goto-field")))
+(register-definition-prefixes "url-mailto" '("url-mail-goto-field"))
;;;***
;;;### (autoloads nil "url-methods" "url/url-methods.el" (0 0 0 0))
;;; Generated autoloads from url/url-methods.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-methods" '("url-scheme-")))
+(register-definition-prefixes "url-methods" '("url-scheme-"))
;;;***
@@ -35491,7 +35171,7 @@ Fetch a data URL (RFC 2397).
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-misc" '("url-do-terminal-emulator")))
+(register-definition-prefixes "url-misc" '("url-do-terminal-emulator"))
;;;***
@@ -35508,14 +35188,14 @@ Fetch a data URL (RFC 2397).
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-news" '("url-news-")))
+(register-definition-prefixes "url-news" '("url-news-"))
;;;***
;;;### (autoloads nil "url-nfs" "url/url-nfs.el" (0 0 0 0))
;;; Generated autoloads from url/url-nfs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-nfs" '("url-nfs")))
+(register-definition-prefixes "url-nfs" '("url-nfs"))
;;;***
@@ -35568,7 +35248,7 @@ parses to
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-parse" '("url-")))
+(register-definition-prefixes "url-parse" '("url-"))
;;;***
@@ -35578,14 +35258,14 @@ parses to
(autoload 'url-setup-privacy-info "url-privacy" "\
Setup variables that expose info about you and your system." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-privacy" '("url-device-type")))
+(register-definition-prefixes "url-privacy" '("url-device-type"))
;;;***
;;;### (autoloads nil "url-proxy" "url/url-proxy.el" (0 0 0 0))
;;; Generated autoloads from url/url-proxy.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-proxy" '("url-")))
+(register-definition-prefixes "url-proxy" '("url-"))
;;;***
@@ -35601,7 +35281,7 @@ The variable `url-queue-timeout' sets a timeout.
\(fn URL CALLBACK &optional CBARGS SILENT INHIBIT-COOKIES)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-queue" '("url-queue")))
+(register-definition-prefixes "url-queue" '("url-queue"))
;;;***
@@ -35621,7 +35301,7 @@ would have been passed to OPERATION.
\(fn OPERATION &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-tramp" '("url-tramp-convert-")))
+(register-definition-prefixes "url-tramp" '("url-tramp-convert-"))
;;;***
@@ -35801,14 +35481,14 @@ is \"www.fsf.co.uk\".
\(fn URL)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-util" '("url-")))
+(register-definition-prefixes "url-util" '("url-"))
;;;***
;;;### (autoloads nil "url-vars" "url/url-vars.el" (0 0 0 0))
;;; Generated autoloads from url/url-vars.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "url-vars" '("url-")))
+(register-definition-prefixes "url-vars" '("url-"))
;;;***
@@ -35845,7 +35525,7 @@ The buffer in question is current when this function is called.
\(fn FILENAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "userlock" '("ask-user-about-" "file-" "userlock--check-content-unchanged")))
+(register-definition-prefixes "userlock" '("ask-user-about-" "file-" "userlock--check-content-unchanged"))
;;;***
@@ -35872,7 +35552,7 @@ The buffer in question is current when this function is called.
\(fn FROM TO)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "utf-7" '("utf-7-")))
+(register-definition-prefixes "utf-7" '("utf-7-"))
;;;***
@@ -35884,7 +35564,7 @@ Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil.
\(fn STRING &optional FOR-IMAP)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "utf7" '("utf7-")))
+(register-definition-prefixes "utf7" '("utf7-"))
;;;***
@@ -35910,7 +35590,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME.
\(fn START END &optional FILE-NAME)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "uudecode" '("uudecode-")))
+(register-definition-prefixes "uudecode" '("uudecode-"))
;;;***
@@ -35947,7 +35627,10 @@ Note that if FILE is a symbolic link, it will not be resolved --
the responsible backend system for the symbolic link itself will
be reported.
-\(fn FILE)" nil nil)
+If NO-ERROR is nil, signal an error that no VC backend is
+responsible for the given file.
+
+\(fn FILE &optional NO-ERROR)" nil nil)
(autoload 'vc-next-action "vc" "\
Do the next logical version control operation on the current fileset.
@@ -36143,7 +35826,7 @@ with its diffs (if the underlying VCS supports that).
\(fn &optional LIMIT REVISION)" t nil)
(autoload 'vc-print-branch-log "vc" "\
-Show the change log for BRANCH in a window.
+Show the change log for BRANCH root in a window.
\(fn BRANCH)" t nil)
@@ -36191,8 +35874,6 @@ Revert working copies of the selected fileset to their repository contents.
This asks for confirmation if the buffer contents are not identical
to the working revision (except for keyword expansion)." t nil)
-(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
-
(autoload 'vc-pull "vc" "\
Update the current fileset or branch.
You must be visiting a version controlled file, or in a `vc-dir' buffer.
@@ -36281,7 +35962,7 @@ Return the branch part of a revision number REV.
\(fn REV)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc" '("vc-" "with-vc-properties")))
+(register-definition-prefixes "vc" '("vc-" "with-vc-properties"))
;;;***
@@ -36322,7 +36003,7 @@ should be applied to the background or to the foreground.
\(fn FILE REV &optional DISPLAY-MODE BUF MOVE-POINT-TO VC-BK)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-annotate" '("vc-")))
+(register-definition-prefixes "vc-annotate" '("vc-"))
;;;***
@@ -36340,7 +36021,7 @@ Name of the format file in a .bzr directory.")
(load "vc-bzr" nil t)
(vc-bzr-registered file))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-bzr" '("vc-bzr-")))
+(register-definition-prefixes "vc-bzr" '("vc-bzr-"))
;;;***
@@ -36353,20 +36034,25 @@ Name of the format file in a .bzr directory.")
(load "vc-cvs" nil t)
(vc-cvs-registered f)))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-cvs" '("vc-cvs-")))
+(register-definition-prefixes "vc-cvs" '("vc-cvs-"))
;;;***
;;;### (autoloads nil "vc-dav" "vc/vc-dav.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-dav.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-dav" '("vc-dav-")))
+(register-definition-prefixes "vc-dav" '("vc-dav-"))
;;;***
;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-dir.el
+(autoload 'vc-dir-root "vc-dir" "\
+Run `vc-dir' in the repository root directory without prompt.
+If the default directory of the current buffer is
+not under version control, prompt for a directory." t nil)
+
(autoload 'vc-dir "vc-dir" "\
Show the VC status for \"interesting\" files in and below DIR.
This allows you to mark files and perform VC operations on them.
@@ -36386,7 +36072,14 @@ These are the commands available for use in the file status buffer:
\(fn DIR &optional BACKEND)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-dir" '("vc-")))
+(autoload 'vc-dir-bookmark-jump "vc-dir" "\
+Provides the bookmark-jump behavior for a `vc-dir' buffer.
+This implements the `handler' function interface for the record
+type returned by `vc-dir-bookmark-make-record'.
+
+\(fn BMK)" nil nil)
+
+(register-definition-prefixes "vc-dir" '("vc-"))
;;;***
@@ -36412,14 +36105,14 @@ case, and the process object in the asynchronous case.
\(fn BUFFER OKSTATUS COMMAND FILE-OR-LIST &rest FLAGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-dispatcher" '("vc-")))
+(register-definition-prefixes "vc-dispatcher" '("vc-"))
;;;***
;;;### (autoloads nil "vc-filewise" "vc/vc-filewise.el" (0 0 0 0))
;;; Generated autoloads from vc/vc-filewise.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-filewise" '("vc-")))
+(register-definition-prefixes "vc-filewise" '("vc-"))
;;;***
@@ -36432,7 +36125,7 @@ case, and the process object in the asynchronous case.
(load "vc-git" nil t)
(vc-git-registered file))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-git" '("vc-git-")))
+(register-definition-prefixes "vc-git" '("vc-git-"))
;;;***
@@ -36445,7 +36138,7 @@ case, and the process object in the asynchronous case.
(load "vc-hg" nil t)
(vc-hg-registered file))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-hg" '("vc-hg-")))
+(register-definition-prefixes "vc-hg" '("vc-hg-"))
;;;***
@@ -36463,7 +36156,7 @@ Name of the monotone directory's format file.")
(load "vc-mtn" nil t)
(vc-mtn-registered file))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-mtn" '("vc-mtn-")))
+(register-definition-prefixes "vc-mtn" '("vc-mtn-"))
;;;***
@@ -36478,7 +36171,7 @@ For a description of possible values, see `vc-check-master-templates'.")
(defun vc-rcs-registered (f) (vc-default-registered 'RCS f))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-rcs" '("vc-r")))
+(register-definition-prefixes "vc-rcs" '("vc-r"))
;;;***
@@ -36498,7 +36191,7 @@ Return the name of a master file in the SCCS project directory.
Does not check whether the file exists but returns nil if it does not
find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) (when project-dir (if (file-name-absolute-p project-dir) (setq dirs '("SCCS" "")) (setq dirs '("src/SCCS" "src" "source/SCCS" "source")) (setq project-dir (expand-file-name (concat "~" project-dir)))) (while (and (not dir) dirs) (setq dir (expand-file-name (car dirs) project-dir)) (unless (file-directory-p dir) (setq dir nil) (setq dirs (cdr dirs)))) (and dir (expand-file-name (concat "s." basename) dir)))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-sccs" '("vc-sccs-")))
+(register-definition-prefixes "vc-sccs" '("vc-sccs-"))
;;;***
@@ -36513,7 +36206,7 @@ For a description of possible values, see `vc-check-master-templates'.")
(defun vc-src-registered (f) (vc-default-registered 'src f))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-src" '("vc-src-")))
+(register-definition-prefixes "vc-src" '("vc-src-"))
;;;***
@@ -36528,14 +36221,14 @@ For a description of possible values, see `vc-check-master-templates'.")
(load "vc-svn" nil t)
(vc-svn-registered f))))
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vc-svn" '("vc-svn-")))
+(register-definition-prefixes "vc-svn" '("vc-svn-"))
;;;***
;;;### (autoloads nil "vcursor" "vcursor.el" (0 0 0 0))
;;; Generated autoloads from vcursor.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vcursor" '("vcursor-")))
+(register-definition-prefixes "vcursor" '("vcursor-"))
;;;***
@@ -36596,14 +36289,14 @@ Key bindings:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vera-mode" '("vera-")))
+(register-definition-prefixes "vera-mode" '("vera-"))
;;;***
;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/verilog-mode.el
-(push (purecopy '(verilog-mode 2019 12 17 268053413)) package--builtin-versions)
+(push (purecopy '(verilog-mode 2020 6 27 14326051)) package--builtin-versions)
(autoload 'verilog-mode "verilog-mode" "\
Major mode for editing Verilog code.
@@ -36739,7 +36432,7 @@ Key bindings specific to `verilog-mode-map' are:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "verilog-mode" '("electric-verilog-" "verilog-" "vl-")))
+(register-definition-prefixes "verilog-mode" '("electric-verilog-" "verilog-" "vl-"))
;;;***
@@ -37296,7 +36989,7 @@ Key bindings:
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vhdl-mode" '("vhdl-")))
+(register-definition-prefixes "vhdl-mode" '("vhdl-"))
;;;***
@@ -37339,7 +37032,7 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics." t nil)
\(fn FROM TO)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viet-util" '("viet-viqr-alist" "viqr-regexp")))
+(register-definition-prefixes "viet-util" '("viet-viqr-alist" "viqr-regexp"))
;;;***
@@ -37479,10 +37172,16 @@ own View-like bindings.
(autoload 'view-mode "view" "\
Toggle View mode, a minor mode for viewing text but not editing it.
-If called interactively, enable View mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `View mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
When View mode is enabled, commands that do not change the buffer
contents are available as usual. Kill commands save text but
@@ -37597,7 +37296,7 @@ This function runs the normal hook `view-mode-hook'.
(autoload 'View-exit-and-edit "view" "\
Exit View mode and make the current buffer editable." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "view" '("View-" "view-")))
+(register-definition-prefixes "view" '("View-" "view-"))
;;;***
@@ -37612,7 +37311,7 @@ If Viper is enabled, turn it off. Otherwise, turn it on." t nil)
(autoload 'viper-mode "viper" "\
Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper" '("set-viper-state-in-major-mode" "this-major-mode-requires-vi-state" "viper-")))
+(register-definition-prefixes "viper" '("set-viper-state-in-major-mode" "this-major-mode-requires-vi-state" "viper-"))
;;;***
@@ -37620,14 +37319,14 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0))
;;; Generated autoloads from emulation/viper-cmd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-cmd" '("viper-")))
+(register-definition-prefixes "viper-cmd" '("viper-"))
;;;***
;;;### (autoloads nil "viper-ex" "emulation/viper-ex.el" (0 0 0 0))
;;; Generated autoloads from emulation/viper-ex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-ex" '("ex-" "viper-")))
+(register-definition-prefixes "viper-ex" '("ex-" "viper-"))
;;;***
@@ -37635,7 +37334,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-init.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-init" '("viper-")))
+(register-definition-prefixes "viper-init" '("viper-"))
;;;***
@@ -37643,7 +37342,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-keym.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-keym" '("ex-read-filename-map" "viper-")))
+(register-definition-prefixes "viper-keym" '("ex-read-filename-map" "viper-"))
;;;***
@@ -37651,7 +37350,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-macs.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-macs" '("ex-" "viper-")))
+(register-definition-prefixes "viper-macs" '("ex-" "viper-"))
;;;***
@@ -37659,7 +37358,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-mous.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-mous" '("viper-")))
+(register-definition-prefixes "viper-mous" '("viper-"))
;;;***
@@ -37667,35 +37366,35 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t nil)
;;;;;; 0 0))
;;; Generated autoloads from emulation/viper-util.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "viper-util" '("viper")))
+(register-definition-prefixes "viper-util" '("viper"))
;;;***
;;;### (autoloads nil "vt-control" "vt-control.el" (0 0 0 0))
;;; Generated autoloads from vt-control.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vt-control" '("vt-")))
+(register-definition-prefixes "vt-control" '("vt-"))
;;;***
;;;### (autoloads nil "vt100-led" "vt100-led.el" (0 0 0 0))
;;; Generated autoloads from vt100-led.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "vt100-led" '("led-")))
+(register-definition-prefixes "vt100-led" '("led-"))
;;;***
;;;### (autoloads nil "w32-fns" "w32-fns.el" (0 0 0 0))
;;; Generated autoloads from w32-fns.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "w32-fns" '("w32-")))
+(register-definition-prefixes "w32-fns" '("w32-"))
;;;***
;;;### (autoloads nil "w32-vars" "w32-vars.el" (0 0 0 0))
;;; Generated autoloads from w32-vars.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "w32-vars" '("w32-")))
+(register-definition-prefixes "w32-vars" '("w32-"))
;;;***
@@ -37757,6 +37456,11 @@ See also `warning-series', `warning-prefix-function',
`warning-fill-prefix', and `warning-fill-column' for additional
programming features.
+This will also display buttons allowing the user to permanently
+disable automatic display of the warning or disable the warning
+entirely by setting `warning-suppress-types' or
+`warning-suppress-log-types' on their behalf.
+
\(fn TYPE MESSAGE &optional LEVEL BUFFER-NAME)" nil nil)
(autoload 'lwarn "warnings" "\
@@ -37789,13 +37493,12 @@ this is equivalent to `display-warning', using
\(fn MESSAGE &rest ARGS)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "warnings" '("display-warning-minimum-level" "log-warning-minimum-level" "warning-")))
+(register-definition-prefixes "warnings" '("warning-"))
;;;***
;;;### (autoloads nil "wdired" "wdired.el" (0 0 0 0))
;;; Generated autoloads from wdired.el
-(push (purecopy '(wdired 2 0)) package--builtin-versions)
(autoload 'wdired-change-to-wdired-mode "wdired" "\
Put a Dired buffer in Writable Dired (WDired) mode.
@@ -37807,7 +37510,7 @@ directories to reflect your edits.
See `wdired-mode'." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "wdired" '("wdired-")))
+(register-definition-prefixes "wdired" '("wdired-"))
;;;***
@@ -37823,7 +37526,7 @@ hotlist.
Please submit bug reports and other feedback to the author, Neil W. Van Dyke
<nwv@acm.org>." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "webjump" '("webjump-")))
+(register-definition-prefixes "webjump" '("webjump-"))
;;;***
@@ -37848,10 +37551,16 @@ or call the function `which-function-mode'.")
(autoload 'which-function-mode "which-func" "\
Toggle mode line display of current function (Which Function mode).
-If called interactively, enable Which-Function mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Which-Function mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Which Function mode is a global minor mode. When enabled, the
current function name is continuously displayed in the mode line,
@@ -37859,7 +37568,7 @@ in certain major modes.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "which-func" '("which-func")))
+(register-definition-prefixes "which-func" '("which-func"))
;;;***
@@ -37870,10 +37579,16 @@ in certain major modes.
(autoload 'whitespace-mode "whitespace" "\
Toggle whitespace visualization (Whitespace mode).
-If called interactively, enable Whitespace mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Whitespace mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
See also `whitespace-style', `whitespace-newline' and
`whitespace-display-mappings'.
@@ -37883,10 +37598,16 @@ See also `whitespace-style', `whitespace-newline' and
(autoload 'whitespace-newline-mode "whitespace" "\
Toggle newline visualization (Whitespace Newline mode).
-If called interactively, enable Whitespace-Newline mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Whitespace-Newline mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Use `whitespace-newline-mode' only for NEWLINE visualization
exclusively. For other visualizations, including NEWLINE
@@ -37910,10 +37631,16 @@ or call the function `global-whitespace-mode'.")
(autoload 'global-whitespace-mode "whitespace" "\
Toggle whitespace visualization globally (Global Whitespace mode).
-If called interactively, enable Global Whitespace mode if ARG is
-positive, and disable it if ARG is zero or negative. If called from
-Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
-ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Global Whitespace mode'. If the
+prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
See also `whitespace-style', `whitespace-newline' and
`whitespace-display-mappings'.
@@ -37933,10 +37660,16 @@ or call the function `global-whitespace-newline-mode'.")
(autoload 'global-whitespace-newline-mode "whitespace" "\
Toggle global newline visualization (Global Whitespace Newline mode).
-If called interactively, enable Global Whitespace-Newline mode if ARG
-is positive, and disable it if ARG is zero or negative. If called
-from Lisp, also enable the mode if ARG is omitted or nil, and toggle
-it if ARG is `toggle'; disable the mode otherwise.
+If called interactively, toggle `Global Whitespace-Newline mode'. If
+the prefix argument is positive, enable the mode, and if it is zero or
+negative, disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Use `global-whitespace-newline-mode' only for NEWLINE
visualization exclusively. For other visualizations, including
@@ -38232,7 +37965,7 @@ cleaning up these problems.
\(fn START END &optional FORCE REPORT-IF-BOGUS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "whitespace" '("whitespace-")))
+(register-definition-prefixes "whitespace" '("whitespace-"))
;;;***
@@ -38257,14 +37990,20 @@ Show widget browser for WIDGET in other window.
(autoload 'widget-minor-mode "wid-browse" "\
Minor mode for traversing widgets.
-If called interactively, enable Widget minor mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Widget minor mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "wid-browse" '("widget-")))
+(register-definition-prefixes "wid-browse" '("widget-"))
;;;***
@@ -38306,7 +38045,7 @@ Note that such modes will need to require wid-edit.")
(autoload 'widget-setup "wid-edit" "\
Setup current buffer so editing string widgets works." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "wid-edit" '("widget-")))
+(register-definition-prefixes "wid-edit" '("widget-"))
;;;***
@@ -38394,6 +38133,11 @@ Display the next buffer in the same window.
\(fn &optional ARG)" t nil)
+(autoload 'windmove-display-new-frame "windmove" "\
+Display the next buffer in a new frame.
+
+\(fn &optional ARG)" t nil)
+
(autoload 'windmove-display-new-tab "windmove" "\
Display the next buffer in a new tab.
@@ -38466,7 +38210,7 @@ or a single modifier. Default value of MODIFIERS is `shift-super'.
\(fn &optional MODIFIERS)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "windmove" '("windmove-")))
+(register-definition-prefixes "windmove" '("windmove-"))
;;;***
@@ -38486,10 +38230,16 @@ or call the function `winner-mode'.")
(autoload 'winner-mode "winner" "\
Toggle Winner mode on or off.
-If called interactively, enable Winner mode if ARG is positive, and
-disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Winner mode'. If the prefix argument
+is positive, enable the mode, and if it is zero or negative, disable
+the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Winner mode is a global minor mode that records the changes in
the window configuration (i.e. how the frames are partitioned
@@ -38500,13 +38250,12 @@ you can press `C-c <right>' (calling `winner-redo').
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "winner" '("winner-")))
+(register-definition-prefixes "winner" '("winner-"))
;;;***
;;;### (autoloads nil "woman" "woman.el" (0 0 0 0))
;;; Generated autoloads from woman.el
-(push (purecopy '(woman 0 551)) package--builtin-versions)
(defvar woman-locale nil "\
String specifying a manual page locale, or nil.
@@ -38549,21 +38298,21 @@ Default bookmark handler for Woman buffers.
\(fn BOOKMARK)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "woman" '("WoMan-" "menu-bar-manuals-menu" "set-woman-file-regexp" "woman")))
+(register-definition-prefixes "woman" '("WoMan-" "menu-bar-manuals-menu" "set-woman-file-regexp" "woman"))
;;;***
;;;### (autoloads nil "x-dnd" "x-dnd.el" (0 0 0 0))
;;; Generated autoloads from x-dnd.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "x-dnd" '("x-dnd-")))
+(register-definition-prefixes "x-dnd" '("x-dnd-"))
;;;***
;;;### (autoloads nil "xdg" "xdg.el" (0 0 0 0))
;;; Generated autoloads from xdg.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xdg" '("xdg-")))
+(register-definition-prefixes "xdg" '("xdg-"))
;;;***
@@ -38627,7 +38376,7 @@ All text between the <!-- ... --> markers will be removed.
\(fn BEG END)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xml" '("xml-")))
+(register-definition-prefixes "xml" '("xml-"))
;;;***
@@ -38647,12 +38396,13 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT.
\(fn &optional LIMIT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xmltok" '("xmltok-")))
+(register-definition-prefixes "xmltok" '("xmltok-"))
;;;***
;;;### (autoloads nil "xref" "progmodes/xref.el" (0 0 0 0))
;;; Generated autoloads from progmodes/xref.el
+(push (purecopy '(xref 1 0 3)) package--builtin-versions)
(autoload 'xref-find-backend "xref" nil nil nil)
@@ -38738,21 +38488,21 @@ FILES must be a list of absolute file names.
\(fn REGEXP FILES)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xref" '("xref-")))
+(register-definition-prefixes "xref" '("xref-"))
;;;***
;;;### (autoloads nil "xscheme" "progmodes/xscheme.el" (0 0 0 0))
;;; Generated autoloads from progmodes/xscheme.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xscheme" '("default-xscheme-runlight" "exit-scheme-interaction-mode" "global-set-scheme-interaction-buffer" "local-" "reset-scheme" "run-scheme" "scheme-" "start-scheme" "verify-xscheme-buffer" "xscheme-")))
+(register-definition-prefixes "xscheme" '("default-xscheme-runlight" "exit-scheme-interaction-mode" "global-set-scheme-interaction-buffer" "local-" "reset-scheme" "run-scheme" "scheme-" "start-scheme" "verify-xscheme-buffer" "xscheme-"))
;;;***
;;;### (autoloads nil "xsd-regexp" "nxml/xsd-regexp.el" (0 0 0 0))
;;; Generated autoloads from nxml/xsd-regexp.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xsd-regexp" '("xsdre-")))
+(register-definition-prefixes "xsd-regexp" '("xsdre-"))
;;;***
@@ -38772,10 +38522,16 @@ or call the function `xterm-mouse-mode'.")
(autoload 'xterm-mouse-mode "xt-mouse" "\
Toggle XTerm mouse mode.
-If called interactively, enable Xterm-Mouse mode if ARG is positive,
-and disable it if ARG is zero or negative. If called from Lisp, also
-enable the mode if ARG is omitted or nil, and toggle it if ARG is
-`toggle'; disable the mode otherwise.
+If called interactively, toggle `Xterm-Mouse mode'. If the prefix
+argument is positive, enable the mode, and if it is zero or negative,
+disable the mode.
+
+If called from Lisp, toggle the mode if if ARG is `toggle'. Enable
+the mode if ARG is nil, omitted, or is a positive number. All other
+values will disable the mode.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
Turn it on to use Emacs mouse commands, and off to use xterm mouse commands.
This works in terminal emulators compatible with xterm. It only
@@ -38786,7 +38542,7 @@ down the SHIFT key while pressing the mouse button.
\(fn &optional ARG)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xt-mouse" '("turn-o" "xt-mouse-epoch" "xterm-mouse-")))
+(register-definition-prefixes "xt-mouse" '("turn-o" "xt-mouse-epoch" "xterm-mouse-"))
;;;***
@@ -38800,7 +38556,7 @@ Interactively, URL defaults to the string looking like a url around point.
\(fn URL &optional NEW-SESSION)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xwidget" '("xwidget-")))
+(register-definition-prefixes "xwidget" '("xwidget-"))
;;;***
@@ -38815,14 +38571,14 @@ Yenc decode region between START and END using an internal decoder.
(autoload 'yenc-extract-filename "yenc" "\
Extract file name from an yenc header." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "yenc" '("yenc-")))
+(register-definition-prefixes "yenc" '("yenc-"))
;;;***
;;;### (autoloads nil "zeroconf" "net/zeroconf.el" (0 0 0 0))
;;; Generated autoloads from net/zeroconf.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "zeroconf" '("zeroconf-")))
+(register-definition-prefixes "zeroconf" '("zeroconf-"))
;;;***
@@ -38832,7 +38588,7 @@ Extract file name from an yenc header." nil nil)
(autoload 'zone "zone" "\
Zone out, completely." t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "zone" '("zone-")))
+(register-definition-prefixes "zone" '("zone-"))
;;;***
@@ -38878,31 +38634,40 @@ Zone out, completely." t nil)
;;;;;; "electric.el" "emacs-lisp/backquote.el" "emacs-lisp/byte-run.el"
;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-preloaded.el"
;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/eieio-compat.el" "emacs-lisp/eieio-custom.el"
-;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eldoc.el" "emacs-lisp/float-sup.el"
-;;;;;; "emacs-lisp/lisp-mode.el" "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el"
-;;;;;; "emacs-lisp/map-ynp.el" "emacs-lisp/nadvice.el" "emacs-lisp/syntax.el"
-;;;;;; "emacs-lisp/timer.el" "env.el" "epa-hook.el" "erc/erc-autoaway.el"
-;;;;;; "erc/erc-button.el" "erc/erc-capab.el" "erc/erc-compat.el"
-;;;;;; "erc/erc-dcc.el" "erc/erc-desktop-notifications.el" "erc/erc-ezbounce.el"
-;;;;;; "erc/erc-fill.el" "erc/erc-identd.el" "erc/erc-imenu.el"
-;;;;;; "erc/erc-join.el" "erc/erc-list.el" "erc/erc-log.el" "erc/erc-match.el"
-;;;;;; "erc/erc-menu.el" "erc/erc-netsplit.el" "erc/erc-notify.el"
-;;;;;; "erc/erc-page.el" "erc/erc-pcomplete.el" "erc/erc-replace.el"
-;;;;;; "erc/erc-ring.el" "erc/erc-services.el" "erc/erc-sound.el"
-;;;;;; "erc/erc-speedbar.el" "erc/erc-spelling.el" "erc/erc-stamp.el"
-;;;;;; "erc/erc-track.el" "erc/erc-truncate.el" "erc/erc-xdcc.el"
-;;;;;; "eshell/em-alias.el" "eshell/em-banner.el" "eshell/em-basic.el"
-;;;;;; "eshell/em-cmpl.el" "eshell/em-dirs.el" "eshell/em-glob.el"
-;;;;;; "eshell/em-hist.el" "eshell/em-ls.el" "eshell/em-pred.el"
-;;;;;; "eshell/em-prompt.el" "eshell/em-rebind.el" "eshell/em-script.el"
-;;;;;; "eshell/em-smart.el" "eshell/em-term.el" "eshell/em-tramp.el"
-;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "facemenu.el" "faces.el"
-;;;;;; "files.el" "font-core.el" "font-lock.el" "format.el" "frame.el"
-;;;;;; "help.el" "hfy-cmap.el" "ibuf-ext.el" "indent.el" "international/characters.el"
+;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/float-sup.el" "emacs-lisp/lisp-mode.el"
+;;;;;; "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el" "emacs-lisp/map-ynp.el"
+;;;;;; "emacs-lisp/nadvice.el" "emacs-lisp/syntax.el" "emacs-lisp/timer.el"
+;;;;;; "env.el" "epa-hook.el" "erc/erc-autoaway.el" "erc/erc-button.el"
+;;;;;; "erc/erc-capab.el" "erc/erc-dcc.el" "erc/erc-desktop-notifications.el"
+;;;;;; "erc/erc-ezbounce.el" "erc/erc-fill.el" "erc/erc-identd.el"
+;;;;;; "erc/erc-imenu.el" "erc/erc-join.el" "erc/erc-list.el" "erc/erc-log.el"
+;;;;;; "erc/erc-match.el" "erc/erc-menu.el" "erc/erc-netsplit.el"
+;;;;;; "erc/erc-notify.el" "erc/erc-page.el" "erc/erc-pcomplete.el"
+;;;;;; "erc/erc-replace.el" "erc/erc-ring.el" "erc/erc-services.el"
+;;;;;; "erc/erc-sound.el" "erc/erc-speedbar.el" "erc/erc-spelling.el"
+;;;;;; "erc/erc-stamp.el" "erc/erc-status-sidebar.el" "erc/erc-track.el"
+;;;;;; "erc/erc-truncate.el" "erc/erc-xdcc.el" "eshell/em-alias.el"
+;;;;;; "eshell/em-banner.el" "eshell/em-basic.el" "eshell/em-cmpl.el"
+;;;;;; "eshell/em-dirs.el" "eshell/em-glob.el" "eshell/em-hist.el"
+;;;;;; "eshell/em-ls.el" "eshell/em-pred.el" "eshell/em-prompt.el"
+;;;;;; "eshell/em-rebind.el" "eshell/em-script.el" "eshell/em-smart.el"
+;;;;;; "eshell/em-term.el" "eshell/em-tramp.el" "eshell/em-unix.el"
+;;;;;; "eshell/em-xtra.el" "facemenu.el" "faces.el" "files.el" "font-core.el"
+;;;;;; "font-lock.el" "format.el" "frame.el" "help.el" "hfy-cmap.el"
+;;;;;; "ibuf-ext.el" "indent.el" "international/characters.el" "international/charprop.el"
;;;;;; "international/charscript.el" "international/cp51932.el"
;;;;;; "international/eucjp-ms.el" "international/mule-cmds.el"
-;;;;;; "international/mule-conf.el" "international/mule.el" "isearch.el"
-;;;;;; "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el"
+;;;;;; "international/mule-conf.el" "international/mule.el" "international/uni-bidi.el"
+;;;;;; "international/uni-brackets.el" "international/uni-category.el"
+;;;;;; "international/uni-combining.el" "international/uni-comment.el"
+;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el"
+;;;;;; "international/uni-digit.el" "international/uni-lowercase.el"
+;;;;;; "international/uni-mirrored.el" "international/uni-name.el"
+;;;;;; "international/uni-numeric.el" "international/uni-old-name.el"
+;;;;;; "international/uni-special-lowercase.el" "international/uni-special-titlecase.el"
+;;;;;; "international/uni-special-uppercase.el" "international/uni-titlecase.el"
+;;;;;; "international/uni-uppercase.el" "isearch.el" "jit-lock.el"
+;;;;;; "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el"
;;;;;; "language/chinese.el" "language/cyrillic.el" "language/czech.el"
;;;;;; "language/english.el" "language/ethiopic.el" "language/european.el"
;;;;;; "language/georgian.el" "language/greek.el" "language/hebrew.el"
diff --git a/lisp/leim/quail/compose.el b/lisp/leim/quail/compose.el
new file mode 100644
index 00000000000..de251a364e6
--- /dev/null
+++ b/lisp/leim/quail/compose.el
@@ -0,0 +1,2952 @@
+;;; compose.el --- Quail package for Multi_key character composition -*-coding: utf-8;-*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Juri Linkov <juri@linkov.net>
+;; Keywords: multilingual, input method, i18n
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This input method supports the same key sequences as defined by the
+;; standard X Multi_key: https://en.wikipedia.org/wiki/Compose_key
+
+;; You can enable this input method transiently with `C-u C-x \ compose RET'.
+;; Then typing `C-x \' will enable this input method temporarily, and
+;; after typing a key sequence it will be disabled. So typing
+;; e.g. `C-x \ E =' will insert the Euro sign character, and disable
+;; this input method automatically afterwards.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "compose" "UTF-8" "+" t
+ "Compose-like input method with the same key sequences as X Multi_key.
+Examples:
+ E = -> € 1 2 -> ½ ^ 3 -> ³"
+ '(("\t" . quail-completion))
+ t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("''" ?´)
+ ("-^" ?¯)
+ ("^-" ?¯)
+ ("__" ?¯)
+ ("_^" ?¯)
+ (" (" ?˘)
+ ("( " ?˘)
+ ("\"\"" ?¨)
+ (" <" ?ˇ)
+ ("< " ?ˇ)
+ ("-- " ?­)
+ ("++" ?#)
+ ("' " ?\')
+ (" '" ?\')
+ ("AT" ?@)
+ ("((" ?\[)
+ ("//" ["\\\\"])
+ ("/<" ["\\\\"])
+ ("</" ["\\\\"])
+ ("))" ?\])
+ ("^ " ?^)
+ (" ^" ?^)
+ ("> " ?^)
+ (" >" ?^)
+ ("` " ?`)
+ (" `" ?`)
+ (", " ?¸)
+ (" ," ?¸)
+ (",," ?¸)
+ ("(-" ?\{)
+ ("-(" ?\{)
+ ("/^" ?|)
+ ("^/" ?|)
+ ("VL" ?|)
+ ("LV" ?|)
+ ("vl" ?|)
+ ("lv" ?|)
+ (")-" ?\})
+ ("-)" ?\})
+ ("~ " ?~)
+ (" ~" ?~)
+ ("- " ?~)
+ (" -" ?~)
+ (" " ? )
+ (" ." ? )
+ ("oc" ?©)
+ ("oC" ?©)
+ ("Oc" ?©)
+ ("OC" ?©)
+ ("Co" ?©)
+ ("CO" ?©)
+ ("or" ?®)
+ ("oR" ?®)
+ ("Or" ?®)
+ ("OR" ?®)
+ ("Ro" ?®)
+ ("RO" ?®)
+ (".>" ?›)
+ (".<" ?‹)
+ (".." ?…)
+ (".-" ?·)
+ (".^" ?·)
+ ("^." ?·)
+ (".=" ?•)
+ ("!^" ?¦)
+ ("!!" ?¡)
+ ("p!" ?¶)
+ ("P!" ?¶)
+ ("+-" ?±)
+ ("-+" ?±)
+ ("??" ?¿)
+ ("ss" ?ß)
+ ("SS" ?ẞ)
+ ("oe" ?Å“)
+ ("OE" ?Å’)
+ ("ae" ?æ)
+ ("AE" ?Æ)
+ ("ff" ?ff)
+ ("fi" ?ï¬)
+ ("fl" ?fl)
+ ("Fi" ?ffi)
+ ("Fl" ?ffl)
+ ("IJ" ?IJ)
+ ("Ij" ?IJ)
+ ("ij" ?ij)
+ ("oo" ?°)
+ ("*0" ?°)
+ ("0*" ?°)
+ ("<<" ?«)
+ (">>" ?»)
+ ("<'" ?‘)
+ ("'<" ?‘)
+ (">'" ?’)
+ ("'>" ?’)
+ (",'" ?‚)
+ ("'," ?‚)
+ ("<\"" ?“)
+ ("\"<" ?“)
+ (">\"" ?â€)
+ ("\">" ?â€)
+ (",\"" ?„)
+ ("\"," ?„)
+ ("%o" ?‰)
+ ("CE" ?â‚ )
+ ("C/" ?â‚¡)
+ ("/C" ?â‚¡)
+ ("Cr" ?â‚¢)
+ ("Fr" ?â‚£)
+ ("L=" ?₤)
+ ("=L" ?₤)
+ ("m/" ?â‚¥)
+ ("/m" ?â‚¥)
+ ("N=" ?₦)
+ ("=N" ?₦)
+ ("Pt" ?â‚§)
+ ("Rs" ?₨)
+ ("W=" ?â‚©)
+ ("=W" ?â‚©)
+ ("d=" ?â‚«)
+ ("=d" ?â‚«)
+ ("C=" ?€)
+ ("=C" ?€)
+ ("c=" ?€)
+ ("=c" ?€)
+ ("E=" ?€)
+ ("=E" ?€)
+ ("e=" ?€)
+ ("=e" ?€)
+ ("С=" ?€)
+ ("=С" ?€)
+ ("Е=" ?€)
+ ("=Е" ?€)
+ ("P=" ?₽)
+ ("p=" ?₽)
+ ("=P" ?₽)
+ ("=p" ?₽)
+ ("З=" ?₽)
+ ("з=" ?₽)
+ ("=З" ?₽)
+ ("=з" ?₽)
+ ("R=" ?₹)
+ ("=R" ?₹)
+ ("r=" ?₹)
+ ("=r" ?₹)
+ ("C|" ?¢)
+ ("|C" ?¢)
+ ("c|" ?¢)
+ ("|c" ?¢)
+ ("c/" ?¢)
+ ("/c" ?¢)
+ ("L-" ?£)
+ ("-L" ?£)
+ ("l-" ?£)
+ ("-l" ?£)
+ ("Y=" ?Â¥)
+ ("=Y" ?Â¥)
+ ("y=" ?Â¥)
+ ("=y" ?Â¥)
+ ("Y-" ?Â¥)
+ ("-Y" ?Â¥)
+ ("y-" ?Â¥)
+ ("-y" ?Â¥)
+ ("fs" ?Å¿)
+ ("fS" ?Å¿)
+ ("--." ?–)
+ ("---" ?—)
+ ("#q" ?♩)
+ ("#e" ?♪)
+ ("#E" ?♫)
+ ("#S" ?♬)
+ ("#b" ?â™­)
+ ("#f" ?â™®)
+ ("##" ?♯)
+ ("so" ?§)
+ ("os" ?§)
+ ("SO" ?§)
+ ("OS" ?§)
+ ("s!" ?§)
+ ("S!" ?§)
+ ("па" ?§)
+ ("ox" ?¤)
+ ("xo" ?¤)
+ ("oX" ?¤)
+ ("Xo" ?¤)
+ ("OX" ?¤)
+ ("XO" ?¤)
+ ("Ox" ?¤)
+ ("xO" ?¤)
+ ("PP" ?¶)
+ ("No" ?â„–)
+ ("NO" ?â„–)
+ ("Ðо" ?â„–)
+ ("ÐО" ?â„–)
+ ("?!" ?⸘)
+ ("!?" ?‽)
+ ("CCCP" ?☭)
+ ("OA" ?â’¶)
+ ("<3" ?♥)
+ (":)" ?☺)
+ (":(" ?☹)
+ ("\\o/" ?🙌)
+ ("poo" ?💩)
+ ("FU" ?🖕)
+ ("LLAP" ?🖖)
+ ("ᄀᄀ" ?á„)
+ ("ᄃᄃ" ?ᄄ)
+ ("ᄇᄇ" ?ᄈ)
+ ("ᄉᄉ" ?ᄊ)
+ ("ᄌᄌ" ?á„)
+ ("á„‚á„€" ?á„“)
+ ("á„‚á„‚" ?á„”)
+ ("ᄂᄃ" ?ᄕ)
+ ("ᄂᄇ" ?ᄖ)
+ ("ᄃᄀ" ?ᄗ)
+ ("ᄅᄂ" ?ᄘ)
+ ("á„…á„…" ?á„™)
+ ("ᄅᄒ" ?ᄚ)
+ ("á„…á„‹" ?á„›)
+ ("ᄆᄇ" ?ᄜ)
+ ("ᄆᄋ" ?á„)
+ ("ᄇᄀ" ?ᄞ)
+ ("ᄇᄂ" ?ᄟ)
+ ("ᄇᄃ" ?ᄠ)
+ ("ᄇᄉ" ?ᄡ)
+ ("ᄇᄌ" ?ᄧ)
+ ("ᄇᄎ" ?ᄨ)
+ ("ᄇá„" ?á„©)
+ ("ᄇᄑ" ?ᄪ)
+ ("ᄇᄋ" ?ᄫ)
+ ("ᄉᄀ" ?ᄭ)
+ ("ᄉᄂ" ?ᄮ)
+ ("ᄉᄃ" ?ᄯ)
+ ("ᄉᄅ" ?ᄰ)
+ ("ᄉᄆ" ?ᄱ)
+ ("ᄉᄇ" ?ᄲ)
+ ("ᄉᄋ" ?ᄵ)
+ ("ᄉᄌ" ?ᄶ)
+ ("ᄉᄎ" ?ᄷ)
+ ("ᄉá„" ?ᄸ)
+ ("ᄉá„" ?ᄹ)
+ ("ᄉᄑ" ?ᄺ)
+ ("ᄉᄒ" ?ᄻ)
+ ("ᄼᄼ" ?ᄽ)
+ ("ᄾᄾ" ?ᄿ)
+ ("á„‹á„€" ?á…)
+ ("ᄋᄃ" ?ᅂ)
+ ("ᄋᄆ" ?ᅃ)
+ ("ᄋᄇ" ?ᅄ)
+ ("ᄋᄉ" ?ᅅ)
+ ("á„‹á…€" ?á…†)
+ ("á„‹á„‹" ?á…‡)
+ ("ᄋᄌ" ?ᅈ)
+ ("ᄋᄎ" ?ᅉ)
+ ("á„‹á„" ?á…Š)
+ ("á„‹á„‘" ?á…‹)
+ ("ᄌᄋ" ?á…)
+ ("á…Žá…Ž" ?á…)
+ ("á…á…" ?á…‘)
+ ("ᄎá„" ?á…’)
+ ("ᄎᄒ" ?ᅓ)
+ ("ᄑᄇ" ?ᅖ)
+ ("á„‘á„‹" ?á…—)
+ ("á„’á„’" ?á…˜)
+ ("á…¡á…µ" ?á…¢)
+ ("ᅣᅵ" ?ᅤ)
+ ("ᅥᅵ" ?ᅦ)
+ ("á…§á…µ" ?á…¨)
+ ("á…©á…¡" ?á…ª)
+ ("á…©á…µ" ?á…¬)
+ ("ᅮᅥ" ?ᅯ)
+ ("ᅮᅵ" ?ᅱ)
+ ("ᅳᅵ" ?ᅴ)
+ ("á…¡á…©" ?á…¶)
+ ("á…¡á…®" ?á…·)
+ ("ᅣᅩ" ?ᅸ)
+ ("ᅣᅭ" ?ᅹ)
+ ("ᅥᅩ" ?ᅺ)
+ ("ᅥᅮ" ?ᅻ)
+ ("ᅥᅳ" ?ᅼ)
+ ("á…§á…©" ?á…½)
+ ("á…§á…®" ?á…¾)
+ ("á…©á…¥" ?á…¿)
+ ("ᅩᅦ" ?ᆀ)
+ ("á…©á…¨" ?á†)
+ ("ᅩᅩ" ?ᆂ)
+ ("ᅩᅮ" ?ᆃ)
+ ("ᅭᅣ" ?ᆄ)
+ ("ᅭᅤ" ?ᆅ)
+ ("ᅭᅧ" ?ᆆ)
+ ("ᅭᅩ" ?ᆇ)
+ ("ᅭᅵ" ?ᆈ)
+ ("ᅮᅡ" ?ᆉ)
+ ("ᅮᅢ" ?ᆊ)
+ ("ᅮᅨ" ?ᆌ)
+ ("ᅮᅮ" ?á†)
+ ("ᅲᅡ" ?ᆎ)
+ ("ᅲᅥ" ?á†)
+ ("ᅲᅦ" ?á†)
+ ("ᅲᅧ" ?ᆑ)
+ ("ᅲᅨ" ?ᆒ)
+ ("ᅲᅮ" ?ᆓ)
+ ("ᅲᅵ" ?ᆔ)
+ ("ᅳᅮ" ?ᆕ)
+ ("ᅳᅳ" ?ᆖ)
+ ("ᅴᅮ" ?ᆗ)
+ ("ᅵᅡ" ?ᆘ)
+ ("ᅵᅣ" ?ᆙ)
+ ("ᅵᅩ" ?ᆚ)
+ ("ᅵᅮ" ?ᆛ)
+ ("ᅵᅳ" ?ᆜ)
+ ("ᅵᆞ" ?á†)
+ ("ᆞᅥ" ?ᆟ)
+ ("ᆞᅮ" ?ᆠ)
+ ("ᆞᅵ" ?ᆡ)
+ ("ᆞᆞ" ?ᆢ)
+ ("ᆨᆨ" ?ᆩ)
+ ("ᆨᆺ" ?ᆪ)
+ ("ᆫᆽ" ?ᆬ)
+ ("ᆫᇂ" ?ᆭ)
+ ("ᆯᆨ" ?ᆰ)
+ ("ᆯᆷ" ?ᆱ)
+ ("ᆯᆸ" ?ᆲ)
+ ("ᆯᆺ" ?ᆳ)
+ ("ᆯᇀ" ?ᆴ)
+ ("ᆯá‡" ?ᆵ)
+ ("ᆯᇂ" ?ᆶ)
+ ("ᆸᆺ" ?ᆹ)
+ ("ᆺᆺ" ?ᆻ)
+ ("ᆨᆯ" ?ᇃ)
+ ("ᆫᆨ" ?ᇅ)
+ ("ᆫᆮ" ?ᇆ)
+ ("ᆫᆺ" ?ᇇ)
+ ("ᆫᇫ" ?ᇈ)
+ ("ᆫᇀ" ?ᇉ)
+ ("ᆮᆨ" ?ᇊ)
+ ("ᆮᆯ" ?ᇋ)
+ ("ᆯᆫ" ?á‡)
+ ("ᆯᆮ" ?ᇎ)
+ ("ᆯᆯ" ?á‡)
+ ("ᆯᇫ" ?ᇗ)
+ ("ᆯᆿ" ?ᇘ)
+ ("ᆯᇹ" ?ᇙ)
+ ("ᆷᆨ" ?ᇚ)
+ ("ᆷᆯ" ?ᇛ)
+ ("ᆷᆸ" ?ᇜ)
+ ("ᆷᆺ" ?á‡)
+ ("ᆷᇫ" ?ᇟ)
+ ("ᆷᆾ" ?ᇠ)
+ ("ᆷᇂ" ?ᇡ)
+ ("ᆷᆼ" ?ᇢ)
+ ("ᆸᆯ" ?ᇣ)
+ ("ᆸá‡" ?ᇤ)
+ ("ᆸᇂ" ?ᇥ)
+ ("ᆸᆼ" ?ᇦ)
+ ("ᆺᆨ" ?ᇧ)
+ ("ᆺᆮ" ?ᇨ)
+ ("ᆺᆯ" ?ᇩ)
+ ("ᆺᆸ" ?ᇪ)
+ ("ᆼᆨ" ?ᇬ)
+ ("ᆼᆼ" ?ᇮ)
+ ("ᆼᆿ" ?ᇯ)
+ ("ᇰᆺ" ?ᇱ)
+ ("ᇰᇫ" ?ᇲ)
+ ("á‡á†¸" ?ᇳ)
+ ("á‡á†¼" ?ᇴ)
+ ("ᇂᆫ" ?ᇵ)
+ ("ᇂᆯ" ?ᇶ)
+ ("ᇂᆷ" ?ᇷ)
+ ("ᇂᆸ" ?ᇸ)
+ ("á„¡á„€" ?á„¢)
+ ("ᄡᄃ" ?ᄣ)
+ ("ᄡᄇ" ?ᄤ)
+ ("ᄡᄉ" ?ᄥ)
+ ("ᄡᄌ" ?ᄦ)
+ ("ᄈᄋ" ?ᄬ)
+ ("ᄲᄀ" ?ᄳ)
+ ("ᄊᄉ" ?ᄴ)
+ ("ᅪᅵ" ?ᅫ)
+ ("ᅯᅵ" ?ᅰ)
+ ("ᅯᅳ" ?ᆋ)
+ ("ᆪᆨ" ?ᇄ)
+ ("ᆰᆺ" ?ᇌ)
+ ("ᇎᇂ" ?á‡)
+ ("ᆱᆨ" ?ᇑ)
+ ("ᆱᆺ" ?ᇒ)
+ ("ᆲᆺ" ?ᇓ)
+ ("ᆲᇂ" ?ᇔ)
+ ("ᆲᆼ" ?ᇕ)
+ ("ᆳᆺ" ?ᇖ)
+ ("á‡á†º" ?ᇞ)
+ ("ᇬᆨ" ?ᇭ)
+ ("ᄇᄭ" ?ᄢ)
+ ("ᄇᄯ" ?ᄣ)
+ ("ᄇᄲ" ?ᄤ)
+ ("ᄇᄊ" ?ᄥ)
+ ("ᄇᄶ" ?ᄦ)
+ ("ᄇᄫ" ?ᄬ)
+ ("ᄉᄞ" ?ᄳ)
+ ("ᄉᄊ" ?ᄴ)
+ ("á…©á…¢" ?á…«)
+ ("ᅮᅦ" ?ᅰ)
+ ("ᅮᅼ" ?ᆋ)
+ ("ᆨᇧ" ?ᇄ)
+ ("ᆯᆪ" ?ᇌ)
+ ("ᆯᇚ" ?ᇑ)
+ ("ᆯá‡" ?ᇒ)
+ ("ᆯᆹ" ?ᇓ)
+ ("ᆯᇥ" ?ᇔ)
+ ("ᆯᇦ" ?ᇕ)
+ ("ᆯᆻ" ?ᇖ)
+ ("ᆷᆻ" ?ᇞ)
+ ("ᆼᆩ" ?ᇭ)
+ (",-" ?¬)
+ ("-," ?¬)
+ ("^_a" ?ª)
+ ("^_a" ?ª)
+ ("^2" ?²)
+ ("2^" ?²)
+ ("^3" ?³)
+ ("3^" ?³)
+ ("mu" ?µ)
+ ("/u" ?µ)
+ ("u/" ?µ)
+ ("^1" ?¹)
+ ("1^" ?¹)
+ ("^_o" ?º)
+ ("^_o" ?º)
+ ("14" ?¼)
+ ("12" ?½)
+ ("34" ?¾)
+ ("`A" ?À)
+ ("A`" ?À)
+ ("´A" ?Ã)
+ ("A´" ?Ã)
+ ("'A" ?Ã)
+ ("A'" ?Ã)
+ ("^A" ?Â)
+ ("A^" ?Â)
+ (">A" ?Â)
+ ("A>" ?Â)
+ ("~A" ?Ã)
+ ("A~" ?Ã)
+ ("\"A" ?Ä)
+ ("A\"" ?Ä)
+ ("¨A" ?Ä)
+ ("A¨" ?Ä)
+ ("oA" ?Ã…)
+ ("*A" ?Ã…)
+ ("A*" ?Ã…)
+ ("AA" ?Ã…)
+ (",C" ?Ç)
+ ("C," ?Ç)
+ ("¸C" ?Ç)
+ ("`E" ?È)
+ ("E`" ?È)
+ ("´E" ?É)
+ ("E´" ?É)
+ ("'E" ?É)
+ ("E'" ?É)
+ ("^E" ?Ê)
+ ("E^" ?Ê)
+ (">E" ?Ê)
+ ("E>" ?Ê)
+ ("\"E" ?Ë)
+ ("E\"" ?Ë)
+ ("¨E" ?Ë)
+ ("E¨" ?Ë)
+ ("`I" ?Ì)
+ ("I`" ?Ì)
+ ("´I" ?Ã)
+ ("I´" ?Ã)
+ ("'I" ?Ã)
+ ("I'" ?Ã)
+ ("^I" ?ÃŽ)
+ ("I^" ?ÃŽ)
+ (">I" ?ÃŽ)
+ ("I>" ?ÃŽ)
+ ("\"I" ?Ã)
+ ("I\"" ?Ã)
+ ("¨I" ?Ã)
+ ("I¨" ?Ã)
+ ("'J" ["JÌ"])
+ ("J'" ["JÌ"])
+ ("´J" ["JÌ"])
+ ("J´" ["JÌ"])
+ ("DH" ?Ã)
+ ("~N" ?Ñ)
+ ("N~" ?Ñ)
+ ("`O" ?Ã’)
+ ("O`" ?Ã’)
+ ("´O" ?Ó)
+ ("O´" ?Ó)
+ ("'O" ?Ó)
+ ("O'" ?Ó)
+ ("^O" ?Ô)
+ ("O^" ?Ô)
+ (">O" ?Ô)
+ ("O>" ?Ô)
+ ("~O" ?Õ)
+ ("O~" ?Õ)
+ ("\"O" ?Ö)
+ ("O\"" ?Ö)
+ ("¨O" ?Ö)
+ ("O¨" ?Ö)
+ ("xx" ?×)
+ ("/O" ?Ø)
+ ("O/" ?Ø)
+ ("`U" ?Ù)
+ ("U`" ?Ù)
+ ("´U" ?Ú)
+ ("U´" ?Ú)
+ ("'U" ?Ú)
+ ("U'" ?Ú)
+ ("^U" ?Û)
+ ("U^" ?Û)
+ (">U" ?Û)
+ ("U>" ?Û)
+ ("\"U" ?Ü)
+ ("U\"" ?Ü)
+ ("¨U" ?Ü)
+ ("U¨" ?Ü)
+ ("´Y" ?Ã)
+ ("Y´" ?Ã)
+ ("'Y" ?Ã)
+ ("Y'" ?Ã)
+ ("TH" ?Þ)
+ ("`a" ?à)
+ ("a`" ?à)
+ ("´a" ?á)
+ ("a´" ?á)
+ ("'a" ?á)
+ ("a'" ?á)
+ ("^a" ?â)
+ ("a^" ?â)
+ (">a" ?â)
+ ("a>" ?â)
+ ("~a" ?ã)
+ ("a~" ?ã)
+ ("\"a" ?ä)
+ ("a\"" ?ä)
+ ("¨a" ?ä)
+ ("a¨" ?ä)
+ ("oa" ?Ã¥)
+ ("*a" ?Ã¥)
+ ("a*" ?Ã¥)
+ ("aa" ?Ã¥)
+ (",c" ?ç)
+ ("c," ?ç)
+ ("¸c" ?ç)
+ ("`e" ?è)
+ ("e`" ?è)
+ ("´e" ?é)
+ ("e´" ?é)
+ ("'e" ?é)
+ ("e'" ?é)
+ ("^e" ?ê)
+ ("e^" ?ê)
+ (">e" ?ê)
+ ("e>" ?ê)
+ ("\"e" ?ë)
+ ("e\"" ?ë)
+ ("¨e" ?ë)
+ ("e¨" ?ë)
+ ("`i" ?ì)
+ ("i`" ?ì)
+ ("´i" ?í)
+ ("i´" ?í)
+ ("'i" ?í)
+ ("i'" ?í)
+ ("^i" ?î)
+ ("i^" ?î)
+ (">i" ?î)
+ ("i>" ?î)
+ ("\"i" ?ï)
+ ("i\"" ?ï)
+ ("¨i" ?ï)
+ ("i¨" ?ï)
+ ("'j" ["jÌ"])
+ ("j'" ["jÌ"])
+ ("´j" ["jÌ"])
+ ("j´" ["jÌ"])
+ ("dh" ?ð)
+ ("~n" ?ñ)
+ ("n~" ?ñ)
+ ("`o" ?ò)
+ ("o`" ?ò)
+ ("´o" ?ó)
+ ("o´" ?ó)
+ ("'o" ?ó)
+ ("o'" ?ó)
+ ("^o" ?ô)
+ ("o^" ?ô)
+ (">o" ?ô)
+ ("o>" ?ô)
+ ("~o" ?õ)
+ ("o~" ?õ)
+ ("o¨" ?ö)
+ ("¨o" ?ö)
+ ("\"o" ?ö)
+ ("o\"" ?ö)
+ (":-" ?÷)
+ ("-:" ?÷)
+ ("/o" ?ø)
+ ("o/" ?ø)
+ ("`u" ?ù)
+ ("u`" ?ù)
+ ("´u" ?ú)
+ ("u´" ?ú)
+ ("'u" ?ú)
+ ("u'" ?ú)
+ ("^u" ?û)
+ ("u^" ?û)
+ (">u" ?û)
+ ("u>" ?û)
+ ("\"u" ?ü)
+ ("u\"" ?ü)
+ ("¨u" ?ü)
+ ("u¨" ?ü)
+ ("´y" ?ý)
+ ("y´" ?ý)
+ ("'y" ?ý)
+ ("y'" ?ý)
+ ("th" ?þ)
+ ("\"y" ?ÿ)
+ ("y\"" ?ÿ)
+ ("¨y" ?ÿ)
+ ("y¨" ?ÿ)
+ ("¯A" ?Ā)
+ ("_A" ?Ä€)
+ ("A_" ?Ä€)
+ ("-A" ?Ä€)
+ ("A-" ?Ä€)
+ ("¯a" ?Ä)
+ ("_a" ?Ä)
+ ("a_" ?Ä)
+ ("-a" ?Ä)
+ ("a-" ?Ä)
+ ("UA" ?Ä‚)
+ ("uA" ?Ä‚)
+ ("bA" ?Ä‚)
+ ("A(" ?Ä‚)
+ ("Ua" ?ă)
+ ("ua" ?ă)
+ ("ba" ?ă)
+ ("a(" ?ă)
+ (";A" ?Ä„)
+ ("A;" ?Ä„)
+ (",A" ?Ä„)
+ ("A," ?Ä„)
+ (";a" ?Ä…)
+ ("a;" ?Ä…)
+ (",a" ?Ä…)
+ ("a," ?Ä…)
+ ("´C" ?Ć)
+ ("'C" ?Ć)
+ ("C'" ?Ć)
+ ("´c" ?ć)
+ ("'c" ?ć)
+ ("c'" ?ć)
+ ("^C" ?Ĉ)
+ ("^c" ?ĉ)
+ (".C" ?ÄŠ)
+ ("C." ?ÄŠ)
+ (".c" ?Ä‹)
+ ("c." ?Ä‹)
+ ("cC" ?Č)
+ ("<C" ?Č)
+ ("C<" ?Č)
+ ("cc" ?Ä)
+ ("<c" ?Ä)
+ ("c<" ?Ä)
+ ("cD" ?ÄŽ)
+ ("<D" ?ÄŽ)
+ ("D<" ?ÄŽ)
+ ("cd" ?Ä)
+ ("<d" ?Ä)
+ ("d<" ?Ä)
+ ("-D" ?Ä)
+ ("D-" ?Ä)
+ ("/D" ?Ä)
+ ("-d" ?Ä‘)
+ ("d-" ?Ä‘)
+ ("/d" ?Ä‘)
+ ("¯E" ?Ē)
+ ("_E" ?Ä’)
+ ("E_" ?Ä’)
+ ("-E" ?Ä’)
+ ("E-" ?Ä’)
+ ("¯e" ?ē)
+ ("_e" ?Ä“)
+ ("e_" ?Ä“)
+ ("-e" ?Ä“)
+ ("e-" ?Ä“)
+ ("UE" ?Ä”)
+ ("bE" ?Ä”)
+ ("Ue" ?Ä•)
+ ("be" ?Ä•)
+ (".E" ?Ä–)
+ ("E." ?Ä–)
+ (".e" ?Ä—)
+ ("e." ?Ä—)
+ (";E" ?Ę)
+ ("E;" ?Ę)
+ (",E" ?Ę)
+ ("E," ?Ę)
+ (";e" ?Ä™)
+ ("e;" ?Ä™)
+ (",e" ?Ä™)
+ ("e," ?Ä™)
+ ("cE" ?Äš)
+ ("<E" ?Äš)
+ ("E<" ?Äš)
+ ("ce" ?Ä›)
+ ("<e" ?Ä›)
+ ("e<" ?Ä›)
+ ("^G" ?Ĝ)
+ ("^g" ?Ä)
+ ("UG" ?Äž)
+ ("GU" ?Äž)
+ ("bG" ?Äž)
+ ("˘G" ?Ğ)
+ ("G˘" ?Ğ)
+ ("G(" ?Äž)
+ ("Ug" ?ÄŸ)
+ ("gU" ?ÄŸ)
+ ("bg" ?ÄŸ)
+ ("˘g" ?ğ)
+ ("g˘" ?ğ)
+ ("g(" ?ÄŸ)
+ (".G" ?Ä )
+ ("G." ?Ä )
+ (".g" ?Ä¡)
+ ("g." ?Ä¡)
+ (",G" ?Ä¢)
+ ("G," ?Ä¢)
+ ("¸G" ?Ģ)
+ (",g" ?Ä£)
+ ("g," ?Ä£)
+ ("¸g" ?ģ)
+ ("^H" ?Ĥ)
+ ("^h" ?Ä¥)
+ ("/H" ?Ħ)
+ ("/h" ?ħ)
+ ("~I" ?Ĩ)
+ ("I~" ?Ĩ)
+ ("~i" ?Ä©)
+ ("i~" ?Ä©)
+ ("¯I" ?Ī)
+ ("_I" ?Ī)
+ ("I_" ?Ī)
+ ("-I" ?Ī)
+ ("I-" ?Ī)
+ ("¯i" ?ī)
+ ("_i" ?Ä«)
+ ("i_" ?Ä«)
+ ("-i" ?Ä«)
+ ("i-" ?Ä«)
+ ("UI" ?Ĭ)
+ ("bI" ?Ĭ)
+ ("Ui" ?Ä­)
+ ("bi" ?Ä­)
+ (";I" ?Ä®)
+ ("I;" ?Ä®)
+ (",I" ?Ä®)
+ ("I," ?Ä®)
+ (";i" ?į)
+ ("i;" ?į)
+ (",i" ?į)
+ ("i," ?į)
+ (".I" ?İ)
+ ("I." ?İ)
+ ("i." ?ı)
+ (".i" ?ı)
+ ("^J" ?Ä´)
+ ("^j" ?ĵ)
+ (",K" ?Ķ)
+ ("K," ?Ķ)
+ ("¸K" ?Ķ)
+ (",k" ?Ä·)
+ ("k," ?Ä·)
+ ("¸k" ?ķ)
+ ("kk" ?ĸ)
+ ("´L" ?Ĺ)
+ ("'L" ?Ĺ)
+ ("L'" ?Ĺ)
+ ("´l" ?ĺ)
+ ("'l" ?ĺ)
+ ("l'" ?ĺ)
+ (",L" ?Ä»)
+ ("L," ?Ä»)
+ ("¸L" ?Ļ)
+ (",l" ?ļ)
+ ("l," ?ļ)
+ ("¸l" ?ļ)
+ ("cL" ?Ľ)
+ ("<L" ?Ľ)
+ ("L<" ?Ľ)
+ ("cl" ?ľ)
+ ("<l" ?ľ)
+ ("l<" ?ľ)
+ ("/L" ?Å)
+ ("L/" ?Å)
+ ("/l" ?Å‚)
+ ("l/" ?Å‚)
+ ("´N" ?Ń)
+ ("'N" ?Ń)
+ ("N'" ?Ń)
+ ("´n" ?ń)
+ ("'n" ?Å„)
+ ("n'" ?Å„)
+ (",N" ?Å…)
+ ("N," ?Å…)
+ ("¸N" ?Ņ)
+ (",n" ?ņ)
+ ("n," ?ņ)
+ ("¸n" ?ņ)
+ ("cN" ?Ň)
+ ("<N" ?Ň)
+ ("N<" ?Ň)
+ ("cn" ?ň)
+ ("<n" ?ň)
+ ("n<" ?ň)
+ ("NG" ?ÅŠ)
+ ("ng" ?Å‹)
+ ("¯O" ?Ō)
+ ("_O" ?Ō)
+ ("O_" ?Ō)
+ ("-O" ?Ō)
+ ("O-" ?Ō)
+ ("¯o" ?Å)
+ ("_o" ?Å)
+ ("o_" ?Å)
+ ("-o" ?Å)
+ ("o-" ?Å)
+ ("UO" ?ÅŽ)
+ ("bO" ?ÅŽ)
+ ("Uo" ?Å)
+ ("bo" ?Å)
+ ("=O" ?Å)
+ ("=o" ?Å‘)
+ ("´R" ?Ŕ)
+ ("'R" ?Å”)
+ ("R'" ?Å”)
+ ("´r" ?ŕ)
+ ("'r" ?Å•)
+ ("r'" ?Å•)
+ (",R" ?Å–)
+ ("R," ?Å–)
+ ("¸R" ?Ŗ)
+ (",r" ?Å—)
+ ("r," ?Å—)
+ ("¸r" ?ŗ)
+ ("cR" ?Ř)
+ ("<R" ?Ř)
+ ("R<" ?Ř)
+ ("cr" ?Å™)
+ ("<r" ?Å™)
+ ("r<" ?Å™)
+ ("´S" ?Ś)
+ ("'S" ?Åš)
+ ("S'" ?Åš)
+ ("´s" ?ś)
+ ("'s" ?Å›)
+ ("s'" ?Å›)
+ ("^S" ?Ŝ)
+ ("^s" ?Å)
+ (",S" ?Åž)
+ ("S," ?Åž)
+ ("¸S" ?Ş)
+ (",s" ?ÅŸ)
+ ("s," ?ÅŸ)
+ ("¸s" ?ş)
+ ("s¸" ?ş)
+ ("cS" ?Å )
+ ("<S" ?Å )
+ ("S<" ?Å )
+ ("cs" ?Å¡)
+ ("<s" ?Å¡)
+ ("s<" ?Å¡)
+ (",T" ?Å¢)
+ ("T," ?Å¢)
+ ("¸T" ?Ţ)
+ (",t" ?Å£)
+ ("t," ?Å£)
+ ("¸t" ?ţ)
+ ("cT" ?Ť)
+ ("<T" ?Ť)
+ ("T<" ?Ť)
+ ("ct" ?Å¥)
+ ("<t" ?Å¥)
+ ("t<" ?Å¥)
+ ("/T" ?Ŧ)
+ ("T/" ?Ŧ)
+ ("T-" ?Ŧ)
+ ("/t" ?ŧ)
+ ("t/" ?ŧ)
+ ("t-" ?ŧ)
+ ("~U" ?Ũ)
+ ("U~" ?Ũ)
+ ("~u" ?Å©)
+ ("u~" ?Å©)
+ ("¯U" ?Ū)
+ ("_U" ?Ū)
+ ("U_" ?Ū)
+ ("-U" ?Ū)
+ ("U-" ?Ū)
+ ("¯u" ?ū)
+ ("_u" ?Å«)
+ ("u_" ?Å«)
+ ("-u" ?Å«)
+ ("u-" ?Å«)
+ ("UU" ?Ŭ)
+ ("uU" ?Ŭ)
+ ("bU" ?Ŭ)
+ ("Uu" ?Å­)
+ ("uu" ?Å­)
+ ("bu" ?Å­)
+ ("oU" ?Å®)
+ ("*U" ?Å®)
+ ("U*" ?Å®)
+ ("ou" ?ů)
+ ("*u" ?ů)
+ ("u*" ?ů)
+ ("=U" ?Ű)
+ ("=u" ?ű)
+ (";U" ?Ų)
+ ("U;" ?Ų)
+ (",U" ?Ų)
+ ("U," ?Ų)
+ (";u" ?ų)
+ ("u;" ?ų)
+ (",u" ?ų)
+ ("u," ?ų)
+ ("^W" ?Å´)
+ ("W^" ?Å´)
+ ("^w" ?ŵ)
+ ("w^" ?ŵ)
+ ("^Y" ?Ŷ)
+ ("Y^" ?Ŷ)
+ ("^y" ?Å·)
+ ("y^" ?Å·)
+ ("\"Y" ?Ÿ)
+ ("Y\"" ?Ÿ)
+ ("¨Y" ?Ÿ)
+ ("Y¨" ?Ÿ)
+ ("´Z" ?Ź)
+ ("'Z" ?Ź)
+ ("Z'" ?Ź)
+ ("´z" ?ź)
+ ("'z" ?ź)
+ ("z'" ?ź)
+ (".Z" ?Å»)
+ ("Z." ?Å»)
+ (".z" ?ż)
+ ("z." ?ż)
+ ("cZ" ?Ž)
+ ("vZ" ?Ž)
+ ("<Z" ?Ž)
+ ("Z<" ?Ž)
+ ("cz" ?ž)
+ ("vz" ?ž)
+ ("<z" ?ž)
+ ("z<" ?ž)
+ ("/b" ?Æ€)
+ ("/I" ?Æ—)
+ ("+O" ?Æ )
+ ("+o" ?Æ¡)
+ ("+U" ?Ư)
+ ("+u" ?ư)
+ ("/Z" ?Ƶ)
+ ("/z" ?ƶ)
+ ("cA" ?Ç)
+ ("ca" ?ÇŽ)
+ ("cI" ?Ç)
+ ("ci" ?Ç)
+ ("cO" ?Ç‘)
+ ("co" ?Ç’)
+ ("cU" ?Ç“)
+ ("cu" ?Ç”)
+ ("¯Ü" ?Ǖ)
+ ("_Ü" ?Ǖ)
+ ("¯\"U" ?Ǖ)
+ ("_\"U" ?Ç•)
+ ("¯ü" ?ǖ)
+ ("_ü" ?ǖ)
+ ("¯\"u" ?ǖ)
+ ("_\"u" ?Ç–)
+ ("´Ü" ?Ǘ)
+ ("'Ü" ?Ǘ)
+ ("´\"U" ?Ǘ)
+ ("'\"U" ?Ç—)
+ ("´ü" ?ǘ)
+ ("'ü" ?ǘ)
+ ("´\"u" ?ǘ)
+ ("'\"u" ?ǘ)
+ ("cÜ" ?Ǚ)
+ ("c\"U" ?Ç™)
+ ("cü" ?ǚ)
+ ("c\"u" ?Çš)
+ ("`Ü" ?Ǜ)
+ ("`\"U" ?Ç›)
+ ("`ü" ?ǜ)
+ ("`\"u" ?ǜ)
+ ("¯Ä" ?Ǟ)
+ ("_Ä" ?Ǟ)
+ ("¯\"A" ?Ǟ)
+ ("_\"A" ?Çž)
+ ("¯ä" ?ǟ)
+ ("_ä" ?ǟ)
+ ("¯\"a" ?ǟ)
+ ("_\"a" ?ÇŸ)
+ ("¯Ȧ" ?Ǡ)
+ ("_Ȧ" ?Ǡ)
+ ("¯.A" ?Ǡ)
+ ("_.A" ?Ç )
+ ("¯ȧ" ?ǡ)
+ ("_ȧ" ?ǡ)
+ ("¯.a" ?ǡ)
+ ("_.a" ?Ç¡)
+ ("¯Æ" ?Ǣ)
+ ("_Æ" ?Ǣ)
+ ("¯æ" ?ǣ)
+ ("_æ" ?ǣ)
+ ("/G" ?Ǥ)
+ ("/g" ?Ç¥)
+ ("cG" ?Ǧ)
+ ("cg" ?ǧ)
+ ("cK" ?Ǩ)
+ ("ck" ?Ç©)
+ (";O" ?Ǫ)
+ ("O;" ?Ǫ)
+ (",O" ?Ǫ)
+ ("O," ?Ǫ)
+ (";o" ?Ç«)
+ ("o;" ?Ç«)
+ (",o" ?Ç«)
+ ("o," ?Ç«)
+ ("¯Ǫ" ?Ǭ)
+ ("_Ǫ" ?Ǭ)
+ ("¯;O" ?Ǭ)
+ ("_;O" ?Ǭ)
+ ("¯ǫ" ?ǭ)
+ ("_Ç«" ?Ç­)
+ ("¯;o" ?ǭ)
+ ("_;o" ?Ç­)
+ ("cÆ·" ?Ç®)
+ ("cʒ" ?ǯ)
+ ("cj" ?ǰ)
+ ("´G" ?Ǵ)
+ ("'G" ?Ç´)
+ ("´g" ?ǵ)
+ ("'g" ?ǵ)
+ ("`N" ?Ǹ)
+ ("`n" ?ǹ)
+ ("´Å" ?Ǻ)
+ ("'Å" ?Ǻ)
+ ("*'A" ?Ǻ)
+ ("´å" ?ǻ)
+ ("'Ã¥" ?Ç»)
+ ("*'a" ?Ç»)
+ ("´Æ" ?Ǽ)
+ ("'Æ" ?Ǽ)
+ ("´æ" ?ǽ)
+ ("'æ" ?ǽ)
+ ("´Ø" ?Ǿ)
+ ("'Ø" ?Ǿ)
+ ("´/O" ?Ǿ)
+ ("'/O" ?Ǿ)
+ ("´ø" ?ǿ)
+ ("'ø" ?ǿ)
+ ("´/o" ?ǿ)
+ ("'/o" ?Ç¿)
+ ("cH" ?Èž)
+ ("ch" ?ÈŸ)
+ (".A" ?Ȧ)
+ (".a" ?ȧ)
+ ("¸E" ?Ȩ)
+ ("¸e" ?ȩ)
+ ("¯Ö" ?Ȫ)
+ ("_Ö" ?Ȫ)
+ ("¯\"O" ?Ȫ)
+ ("_\"O" ?Ȫ)
+ ("¯ö" ?ȫ)
+ ("_ö" ?ȫ)
+ ("¯\"o" ?ȫ)
+ ("_\"o" ?È«)
+ ("¯Õ" ?Ȭ)
+ ("_Õ" ?Ȭ)
+ ("¯~O" ?Ȭ)
+ ("_~O" ?Ȭ)
+ ("¯õ" ?ȭ)
+ ("_õ" ?ȭ)
+ ("¯~o" ?ȭ)
+ ("_~o" ?È­)
+ (".O" ?È®)
+ (".o" ?ȯ)
+ ("¯Ȯ" ?Ȱ)
+ ("_Ȯ" ?Ȱ)
+ ("¯.O" ?Ȱ)
+ ("_.O" ?Ȱ)
+ ("¯ȯ" ?ȱ)
+ ("_ȯ" ?ȱ)
+ ("¯.o" ?ȱ)
+ ("_.o" ?ȱ)
+ ("¯Y" ?Ȳ)
+ ("_Y" ?Ȳ)
+ ("¯y" ?ȳ)
+ ("_y" ?ȳ)
+ ("ee" ?É™)
+ ("/i" ?ɨ)
+ ("/Ê”" ?Ê¡)
+ ("^_h" ?ʰ)
+ ("^_h" ?ʰ)
+ ("^_ɦ" ?ʱ)
+ ("^_ɦ" ?ʱ)
+ ("^_j" ?ʲ)
+ ("^_j" ?ʲ)
+ ("^_r" ?ʳ)
+ ("^_r" ?ʳ)
+ ("^_ɹ" ?ʴ)
+ ("^_ɹ" ?ʴ)
+ ("^_ɻ" ?ʵ)
+ ("^_ɻ" ?ʵ)
+ ("^_Ê" ?ʶ)
+ ("^_Ê" ?ʶ)
+ ("^_w" ?Ê·)
+ ("^_w" ?Ê·)
+ ("^_y" ?ʸ)
+ ("^_y" ?ʸ)
+ ("^_É£" ?Ë )
+ ("^_É£" ?Ë )
+ ("^_l" ?Ë¡)
+ ("^_l" ?Ë¡)
+ ("^_s" ?Ë¢)
+ ("^_s" ?Ë¢)
+ ("^_x" ?Ë£)
+ ("^_x" ?Ë£)
+ ("^_ʕ" ?ˤ)
+ ("^_ʕ" ?ˤ)
+ ("\"´" ?̈́)
+ ("\"'" ?Í„)
+ ("¨´" ?΅)
+ ("¨'" ?΅)
+ ("'\" " ?Î…)
+ ("´Α" ?Ά)
+ ("'Α" ?Ά)
+ ("Α'" ?Ά)
+ ("´Ε" ?Έ)
+ ("'Ε" ?Έ)
+ ("Ε'" ?Έ)
+ ("´Η" ?Ή)
+ ("'Η" ?Ή)
+ ("Η'" ?Ή)
+ ("´Ι" ?Ί)
+ ("'Ι" ?Ί)
+ ("Ι'" ?Ί)
+ ("´Ο" ?Ό)
+ ("'Ο" ?Ό)
+ ("Ο'" ?Ό)
+ ("´Υ" ?Ύ)
+ ("'Î¥" ?ÎŽ)
+ ("Î¥'" ?ÎŽ)
+ ("´Ω" ?Î)
+ ("'Ω" ?Î)
+ ("Ω'" ?Î)
+ ("´ϊ" ?Î)
+ ("'ÏŠ" ?Î)
+ ("´\"ι" ?Î)
+ ("'\"ι" ?Î)
+ ("\"Ι" ?Ϊ)
+ ("Ι\"" ?Ϊ)
+ ("\"Υ" ?Ϋ)
+ ("Υ\"" ?Ϋ)
+ ("´α" ?ά)
+ ("'α" ?ά)
+ ("α'" ?ά)
+ ("´ε" ?έ)
+ ("'ε" ?έ)
+ ("ε'" ?έ)
+ ("´η" ?ή)
+ ("'η" ?ή)
+ ("η'" ?ή)
+ ("´ι" ?ί)
+ ("'ι" ?ί)
+ ("´ϋ" ?ΰ)
+ ("'ϋ" ?ΰ)
+ ("´\"υ" ?ΰ)
+ ("'\"υ" ?ΰ)
+ ("\"ι" ?ϊ)
+ ("ι\"" ?ϊ)
+ ("\"Ï…" ?Ï‹)
+ ("Ï…\"" ?Ï‹)
+ ("´ο" ?ό)
+ ("'ο" ?ό)
+ ("ο'" ?ό)
+ ("´υ" ?Ï)
+ ("'Ï…" ?Ï)
+ ("Ï…'" ?Ï)
+ ("´ω" ?ώ)
+ ("'ω" ?ώ)
+ ("ω'" ?ώ)
+ ("\"Ï’" ?Ï”)
+ ("`Е" ?Ѐ)
+ ("\"Е" ?Ð)
+ ("´Г" ?Ѓ)
+ ("'Г" ?Ѓ)
+ ("\"І" ?Ї)
+ ("´К" ?Ќ)
+ ("'К" ?Ќ)
+ ("`И" ?Ð)
+ ("UУ" ?Ў)
+ ("bУ" ?Ў)
+ ("UИ" ?Й)
+ ("bИ" ?Й)
+ ("Uи" ?й)
+ ("bи" ?й)
+ ("`е" ?Ñ)
+ ("\"е" ?ё)
+ ("´г" ?ѓ)
+ ("'г" ?ѓ)
+ ("\"Ñ–" ?Ñ—)
+ ("´к" ?ќ)
+ ("'к" ?ќ)
+ ("`и" ?Ñ)
+ ("Uу" ?ў)
+ ("bу" ?ў)
+ ("/Г" ?Ғ)
+ ("/г" ?ғ)
+ ("/К" ?Ҟ)
+ ("/к" ?ҟ)
+ ("/Ò®" ?Ò°)
+ ("/Ò¯" ?Ò±)
+ ("UЖ" ?Ó)
+ ("bЖ" ?Ó)
+ ("Uж" ?ӂ)
+ ("bж" ?ӂ)
+ ("UÐ" ?Ó)
+ ("bÐ" ?Ó)
+ ("Uа" ?ӑ)
+ ("bа" ?ӑ)
+ ("\"Ð" ?Ó’)
+ ("\"а" ?ӓ)
+ ("UЕ" ?Ӗ)
+ ("bЕ" ?Ӗ)
+ ("Uе" ?ӗ)
+ ("bе" ?ӗ)
+ ("\"Ó˜" ?Óš)
+ ("\"Ó™" ?Ó›)
+ ("\"Ж" ?Ӝ)
+ ("\"ж" ?Ó)
+ ("\"З" ?Ӟ)
+ ("\"з" ?ӟ)
+ ("¯И" ?Ӣ)
+ ("_И" ?Ӣ)
+ ("¯и" ?ӣ)
+ ("_и" ?ӣ)
+ ("\"И" ?Ӥ)
+ ("\"и" ?ӥ)
+ ("\"О" ?Ӧ)
+ ("\"о" ?ӧ)
+ ("\"Ó¨" ?Óª)
+ ("\"Ó©" ?Ó«)
+ ("\"Э" ?Ӭ)
+ ("\"Ñ" ?Ó­)
+ ("¯У" ?Ӯ)
+ ("_У" ?Ӯ)
+ ("¯у" ?ӯ)
+ ("_у" ?ӯ)
+ ("\"У" ?Ӱ)
+ ("\"у" ?ӱ)
+ ("=У" ?Ӳ)
+ ("=у" ?ӳ)
+ ("\"Ч" ?Ӵ)
+ ("\"ч" ?ӵ)
+ ("\"Ы" ?Ӹ)
+ ("\"Ñ‹" ?Ó¹)
+ ("ٓا" ?آ)
+ ("ٔا" ?أ)
+ ("ٔو" ?ؤ)
+ ("ٕا" ?إ)
+ ("ٔي" ?ئ)
+ ("Ù”Û•" ?Û€)
+ ("Ù”Û" ?Û‚)
+ ("Ù”Û’" ?Û“)
+ ("़न" ?ऩ)
+ ("़र" ?ऱ)
+ ("़ळ" ?ऴ)
+ ("़क" ?क़)
+ ("़ख" ?ख़)
+ ("़ग" ?ग़)
+ ("़ज" ?ज़)
+ ("़ड" ?ड़)
+ ("़ढ" ?à¥)
+ ("़फ" ?फ़)
+ ("़य" ?य़)
+ ("ো" ?ো)
+ ("ৌ" ?ৌ)
+ ("়ড" ?ড়)
+ ("়ঢ" ?à§)
+ ("়য" ?য়)
+ ("਼ਲ" ?ਲ਼)
+ ("਼ਸ" ?ਸ਼)
+ ("਼ਖ" ?ਖ਼)
+ ("਼ਗ" ?ਗ਼)
+ ("਼ਜ" ?ਜ਼)
+ ("਼ਫ" ?ਫ਼)
+ ("ୈ" ?ୈ)
+ ("ୋ" ?ୋ)
+ ("ୌ" ?ୌ)
+ ("଼ଡ" ?ଡ଼)
+ ("଼ଢ" ?à­)
+ ("ௗஒ" ?ஔ)
+ ("ொ" ?ொ)
+ ("ோ" ?ோ)
+ ("ௌ" ?ௌ)
+ ("ై" ?ై)
+ ("ೀ" ?ೀ)
+ ("ೇ" ?ೇ)
+ ("ೈ" ?ೈ)
+ ("ೊ" ?ೊ)
+ ("ೋ" ?ೋ)
+ ("ൊ" ?ൊ)
+ ("ോ" ?ോ)
+ ("ൌ" ?ൌ)
+ ("ේ" ?ේ)
+ ("à·™à·" ?à·œ)
+ ("ෝ" ?à·)
+ ("ෞ" ?ෞ)
+ ("ྷག" ?གྷ)
+ ("ྷཌ" ?à½)
+ ("ྷད" ?དྷ)
+ ("ྷབ" ?བྷ)
+ ("ྷཛ" ?ཛྷ)
+ ("ྵཀ" ?ཀྵ)
+ ("ཱི" ?ཱི)
+ ("ཱུ" ?ཱུ)
+ ("ྲྀ" ?ྲྀ)
+ ("ླྀ" ?ླྀ)
+ ("ཱྀ" ?à¾)
+ ("ྒྷ" ?ྒྷ)
+ ("ྜྷ" ?à¾)
+ ("ྡྷ" ?ྡྷ)
+ ("ྦྷ" ?ྦྷ)
+ ("ྫྷ" ?ྫྷ)
+ ("à¾à¾µ" ?ྐྵ)
+ ("ီဥ" ?ဦ)
+ (".B" ?Ḃ)
+ ("B." ?Ḃ)
+ (".b" ?ḃ)
+ ("b." ?ḃ)
+ ("!B" ?Ḅ)
+ ("!b" ?ḅ)
+ ("´Ç" ?Ḉ)
+ ("'Ç" ?Ḉ)
+ ("´,C" ?Ḉ)
+ ("´¸C" ?Ḉ)
+ ("'¸C" ?Ḉ)
+ ("´ç" ?ḉ)
+ ("'ç" ?ḉ)
+ ("´,c" ?ḉ)
+ ("´¸c" ?ḉ)
+ ("'¸c" ?ḉ)
+ (".D" ?Ḋ)
+ ("D." ?Ḋ)
+ (".d" ?ḋ)
+ ("d." ?ḋ)
+ ("!D" ?Ḍ)
+ ("!d" ?á¸)
+ (",D" ?á¸)
+ ("D," ?á¸)
+ ("¸D" ?á¸)
+ (",d" ?ḑ)
+ ("d," ?ḑ)
+ ("¸d" ?ḑ)
+ ("`Ē" ?Ḕ)
+ ("`¯E" ?Ḕ)
+ ("`_E" ?Ḕ)
+ ("`ē" ?ḕ)
+ ("`¯e" ?ḕ)
+ ("`_e" ?ḕ)
+ ("´Ē" ?Ḗ)
+ ("'Ē" ?Ḗ)
+ ("´¯E" ?Ḗ)
+ ("´_E" ?Ḗ)
+ ("'¯E" ?Ḗ)
+ ("'_E" ?Ḗ)
+ ("´ē" ?ḗ)
+ ("'ē" ?ḗ)
+ ("´¯e" ?ḗ)
+ ("´_e" ?ḗ)
+ ("'¯e" ?ḗ)
+ ("'_e" ?ḗ)
+ ("UȨ" ?Ḝ)
+ ("bȨ" ?Ḝ)
+ ("U ,E" ?Ḝ)
+ ("U¸E" ?Ḝ)
+ ("b,E" ?Ḝ)
+ ("b¸E" ?Ḝ)
+ ("UÈ©" ?á¸)
+ ("bÈ©" ?á¸)
+ ("U ,e" ?á¸)
+ ("U¸e" ?á¸)
+ ("b,e" ?á¸)
+ ("b¸e" ?á¸)
+ (".F" ?Ḟ)
+ ("F." ?Ḟ)
+ (".f" ?ḟ)
+ ("f." ?ḟ)
+ ("¯G" ?Ḡ)
+ ("_G" ?Ḡ)
+ ("¯g" ?ḡ)
+ ("_g" ?ḡ)
+ (".H" ?Ḣ)
+ (".h" ?ḣ)
+ ("!H" ?Ḥ)
+ ("!h" ?ḥ)
+ ("\"H" ?Ḧ)
+ ("\"h" ?ḧ)
+ (",H" ?Ḩ)
+ ("H," ?Ḩ)
+ ("¸H" ?Ḩ)
+ (",h" ?ḩ)
+ ("h," ?ḩ)
+ ("¸h" ?ḩ)
+ ("´Ã" ?Ḯ)
+ ("'Ã" ?Ḯ)
+ ("´\"I" ?Ḯ)
+ ("'\"I" ?Ḯ)
+ ("´ï" ?ḯ)
+ ("'ï" ?ḯ)
+ ("´\"i" ?ḯ)
+ ("'\"i" ?ḯ)
+ ("´K" ?Ḱ)
+ ("'K" ?Ḱ)
+ ("´k" ?ḱ)
+ ("'k" ?ḱ)
+ ("!K" ?Ḳ)
+ ("!k" ?ḳ)
+ ("!L" ?Ḷ)
+ ("!l" ?ḷ)
+ ("¯Ḷ" ?Ḹ)
+ ("_Ḷ" ?Ḹ)
+ ("¯!L" ?Ḹ)
+ ("_!L" ?Ḹ)
+ ("¯ḷ" ?ḹ)
+ ("_ḷ" ?ḹ)
+ ("¯!l" ?ḹ)
+ ("_!l" ?ḹ)
+ ("´M" ?Ḿ)
+ ("'M" ?Ḿ)
+ ("´m" ?ḿ)
+ ("'m" ?ḿ)
+ (".M" ?á¹€)
+ ("M." ?á¹€)
+ (".m" ?á¹)
+ ("m." ?á¹)
+ ("!M" ?Ṃ)
+ ("!m" ?ṃ)
+ (".N" ?Ṅ)
+ (".n" ?á¹…)
+ ("!N" ?Ṇ)
+ ("!n" ?ṇ)
+ ("´Õ" ?Ṍ)
+ ("'Õ" ?Ṍ)
+ ("´~O" ?Ṍ)
+ ("'~O" ?Ṍ)
+ ("´õ" ?á¹)
+ ("'õ" ?á¹)
+ ("´~o" ?á¹)
+ ("'~o" ?á¹)
+ ("\"Õ" ?Ṏ)
+ ("\"~O" ?Ṏ)
+ ("\"õ" ?á¹)
+ ("\"~o" ?á¹)
+ ("`ÅŒ" ?á¹)
+ ("`¯O" ?á¹)
+ ("`_O" ?á¹)
+ ("`Å" ?ṑ)
+ ("`¯o" ?ṑ)
+ ("`_o" ?ṑ)
+ ("´Ō" ?Ṓ)
+ ("'Ō" ?Ṓ)
+ ("´¯O" ?Ṓ)
+ ("´_O" ?Ṓ)
+ ("'¯O" ?Ṓ)
+ ("'_O" ?á¹’)
+ ("´Å" ?ṓ)
+ ("'Å" ?ṓ)
+ ("´¯o" ?ṓ)
+ ("´_o" ?ṓ)
+ ("'¯o" ?ṓ)
+ ("'_o" ?ṓ)
+ ("´P" ?Ṕ)
+ ("'P" ?á¹”)
+ ("´p" ?ṕ)
+ ("'p" ?ṕ)
+ (".P" ?á¹–)
+ ("P." ?á¹–)
+ (".p" ?á¹—)
+ ("p." ?á¹—)
+ (".R" ?Ṙ)
+ (".r" ?á¹™)
+ ("!R" ?Ṛ)
+ ("!r" ?á¹›)
+ ("¯Ṛ" ?Ṝ)
+ ("_Ṛ" ?Ṝ)
+ ("¯!R" ?Ṝ)
+ ("_!R" ?Ṝ)
+ ("¯ṛ" ?á¹)
+ ("_á¹›" ?á¹)
+ ("¯!r" ?á¹)
+ ("_!r" ?á¹)
+ (".S" ?á¹ )
+ ("S." ?á¹ )
+ (".s" ?ṡ)
+ ("s." ?ṡ)
+ ("!S" ?á¹¢)
+ ("!s" ?á¹£)
+ (".Ś" ?Ṥ)
+ (".´S" ?Ṥ)
+ (".'S" ?Ṥ)
+ (".Å›" ?á¹¥)
+ (".´s" ?ṥ)
+ (".'s" ?á¹¥)
+ (".Š" ?Ṧ)
+ (".Å¡" ?á¹§)
+ (".Ṣ" ?Ṩ)
+ (".!S" ?Ṩ)
+ (".ṣ" ?ṩ)
+ (".!s" ?ṩ)
+ (".T" ?Ṫ)
+ ("T." ?Ṫ)
+ (".t" ?ṫ)
+ ("t." ?ṫ)
+ ("!T" ?Ṭ)
+ ("!t" ?á¹­)
+ ("´Ũ" ?Ṹ)
+ ("'Ũ" ?Ṹ)
+ ("´~U" ?Ṹ)
+ ("'~U" ?Ṹ)
+ ("´ũ" ?ṹ)
+ ("'Å©" ?á¹¹)
+ ("´~u" ?ṹ)
+ ("'~u" ?á¹¹)
+ ("\"Ū" ?Ṻ)
+ ("\"¯U" ?Ṻ)
+ ("\"_U" ?Ṻ)
+ ("\"Å«" ?á¹»)
+ ("\"¯u" ?ṻ)
+ ("\"_u" ?á¹»)
+ ("~V" ?á¹¼)
+ ("~v" ?á¹½)
+ ("!V" ?á¹¾)
+ ("!v" ?ṿ)
+ ("`W" ?Ẁ)
+ ("`w" ?áº)
+ ("´W" ?Ẃ)
+ ("'W" ?Ẃ)
+ ("´w" ?ẃ)
+ ("'w" ?ẃ)
+ ("\"W" ?Ẅ)
+ ("\"w" ?ẅ)
+ (".W" ?Ẇ)
+ (".w" ?ẇ)
+ ("!W" ?Ẉ)
+ ("!w" ?ẉ)
+ (".X" ?Ẋ)
+ (".x" ?ẋ)
+ ("\"X" ?Ẍ)
+ ("\"x" ?áº)
+ (".Y" ?Ẏ)
+ (".y" ?áº)
+ ("^Z" ?áº)
+ ("^z" ?ẑ)
+ ("!Z" ?Ẓ)
+ ("!z" ?ẓ)
+ ("\"t" ?ẗ)
+ ("ow" ?ẘ)
+ ("oy" ?ẙ)
+ (".ſ" ?ẛ)
+ ("!A" ?Ạ)
+ ("!a" ?ạ)
+ ("?A" ?Ả)
+ ("?a" ?ả)
+ ("´Â" ?Ấ)
+ ("'Â" ?Ấ)
+ ("´^A" ?Ấ)
+ ("'^A" ?Ấ)
+ ("´â" ?ấ)
+ ("'â" ?ấ)
+ ("´^a" ?ấ)
+ ("'^a" ?ấ)
+ ("`Â" ?Ầ)
+ ("`^A" ?Ầ)
+ ("`â" ?ầ)
+ ("`^a" ?ầ)
+ ("?Â" ?Ẩ)
+ ("?^A" ?Ẩ)
+ ("?â" ?ẩ)
+ ("?^a" ?ẩ)
+ ("~Â" ?Ẫ)
+ ("~^A" ?Ẫ)
+ ("~â" ?ẫ)
+ ("~^a" ?ẫ)
+ ("^Ạ" ?Ậ)
+ ("^!A" ?Ậ)
+ ("^ạ" ?ậ)
+ ("^!a" ?ậ)
+ ("´Ă" ?Ắ)
+ ("'Ă" ?Ắ)
+ ("´bA" ?Ắ)
+ ("'bA" ?Ắ)
+ ("´ă" ?ắ)
+ ("'ă" ?ắ)
+ ("´ba" ?ắ)
+ ("'ba" ?ắ)
+ ("`Ă" ?Ằ)
+ ("`bA" ?Ằ)
+ ("`ă" ?ằ)
+ ("`ba" ?ằ)
+ ("?Ă" ?Ẳ)
+ ("?bA" ?Ẳ)
+ ("?ă" ?ẳ)
+ ("?ba" ?ẳ)
+ ("~Ă" ?Ẵ)
+ ("~bA" ?Ẵ)
+ ("~ă" ?ẵ)
+ ("~ba" ?ẵ)
+ ("UẠ" ?Ặ)
+ ("bẠ" ?Ặ)
+ ("U!A" ?Ặ)
+ ("b!A" ?Ặ)
+ ("Uạ" ?ặ)
+ ("bạ" ?ặ)
+ ("U!a" ?ặ)
+ ("b!a" ?ặ)
+ ("!E" ?Ẹ)
+ ("!e" ?ẹ)
+ ("?E" ?Ẻ)
+ ("?e" ?ẻ)
+ ("~E" ?Ẽ)
+ ("~e" ?ẽ)
+ ("´Ê" ?Ế)
+ ("'Ê" ?Ế)
+ ("´^E" ?Ế)
+ ("'^E" ?Ế)
+ ("´ê" ?ế)
+ ("'ê" ?ế)
+ ("´^e" ?ế)
+ ("'^e" ?ế)
+ ("`Ê" ?Ề)
+ ("`^E" ?Ề)
+ ("`ê" ?á»)
+ ("`^e" ?á»)
+ ("?Ê" ?Ể)
+ ("?^E" ?Ể)
+ ("?ê" ?ể)
+ ("?^e" ?ể)
+ ("~Ê" ?Ễ)
+ ("~^E" ?Ễ)
+ ("~ê" ?ễ)
+ ("~^e" ?á»…)
+ ("^Ẹ" ?Ệ)
+ ("^!E" ?Ệ)
+ ("^ẹ" ?ệ)
+ ("^!e" ?ệ)
+ ("?I" ?Ỉ)
+ ("?i" ?ỉ)
+ ("!I" ?Ị)
+ ("!i" ?ị)
+ ("!O" ?Ọ)
+ ("!o" ?á»)
+ ("?O" ?Ỏ)
+ ("?o" ?á»)
+ ("´Ô" ?á»)
+ ("'Ô" ?á»)
+ ("´^O" ?á»)
+ ("'^O" ?á»)
+ ("´ô" ?ố)
+ ("'ô" ?ố)
+ ("´^o" ?ố)
+ ("'^o" ?ố)
+ ("`Ô" ?Ồ)
+ ("`^O" ?á»’)
+ ("`ô" ?ồ)
+ ("`^o" ?ồ)
+ ("?Ô" ?Ổ)
+ ("?^O" ?á»”)
+ ("?ô" ?ổ)
+ ("?^o" ?ổ)
+ ("~Ô" ?Ỗ)
+ ("~^O" ?á»–)
+ ("~ô" ?ỗ)
+ ("~^o" ?á»—)
+ ("^Ọ" ?Ộ)
+ ("^!O" ?Ộ)
+ ("^á»" ?á»™)
+ ("^!o" ?á»™)
+ ("´Ơ" ?Ớ)
+ ("'Ơ" ?Ớ)
+ ("´+O" ?Ớ)
+ ("'+O" ?Ớ)
+ ("´ơ" ?ớ)
+ ("'Æ¡" ?á»›)
+ ("´+o" ?ớ)
+ ("'+o" ?á»›)
+ ("`Ơ" ?Ờ)
+ ("`+O" ?Ờ)
+ ("`Æ¡" ?á»)
+ ("`+o" ?á»)
+ ("?Ơ" ?Ở)
+ ("?+O" ?Ở)
+ ("?ơ" ?ở)
+ ("?+o" ?ở)
+ ("~Æ " ?á» )
+ ("~+O" ?á» )
+ ("~ơ" ?ỡ)
+ ("~+o" ?ỡ)
+ ("!Ơ" ?Ợ)
+ ("!+O" ?Ợ)
+ ("!ơ" ?ợ)
+ ("!+o" ?ợ)
+ ("!U" ?Ụ)
+ ("!u" ?ụ)
+ ("?U" ?Ủ)
+ ("?u" ?á»§)
+ ("´Ư" ?Ứ)
+ ("'Ư" ?Ứ)
+ ("´+U" ?Ứ)
+ ("'+U" ?Ứ)
+ ("´ư" ?ứ)
+ ("'ư" ?ứ)
+ ("´+u" ?ứ)
+ ("'+u" ?ứ)
+ ("`Ư" ?Ừ)
+ ("`+U" ?Ừ)
+ ("`ư" ?ừ)
+ ("`+u" ?ừ)
+ ("?Ư" ?Ử)
+ ("?+U" ?Ử)
+ ("?ư" ?ử)
+ ("?+u" ?á»­)
+ ("~Ư" ?Ữ)
+ ("~+U" ?á»®)
+ ("~ư" ?ữ)
+ ("~+u" ?ữ)
+ ("!Ư" ?Ự)
+ ("!+U" ?á»°)
+ ("!ư" ?ự)
+ ("!+u" ?á»±)
+ ("`Y" ?Ỳ)
+ ("`y" ?ỳ)
+ ("!Y" ?á»´)
+ ("!y" ?ỵ)
+ ("?Y" ?á»¶)
+ ("?y" ?á»·)
+ ("~Y" ?Ỹ)
+ ("~y" ?ỹ)
+ (")α" ?ἀ)
+ ("(α" ?á¼)
+ ("`ἀ" ?ἂ)
+ ("`)α" ?ἂ)
+ ("`á¼" ?ἃ)
+ ("`(α" ?ἃ)
+ ("´ἀ" ?ἄ)
+ ("'ἀ" ?ἄ)
+ ("´)α" ?ἄ)
+ ("')α" ?ἄ)
+ ("´á¼" ?á¼…)
+ ("'á¼" ?á¼…)
+ ("´(α" ?ἅ)
+ ("'(α" ?ἅ)
+ ("~ἀ" ?ἆ)
+ ("~)α" ?ἆ)
+ ("~á¼" ?ἇ)
+ ("~(α" ?ἇ)
+ (")Α" ?Ἀ)
+ ("(Α" ?Ἁ)
+ ("`Ἀ" ?Ἂ)
+ ("`)Α" ?Ἂ)
+ ("`Ἁ" ?Ἃ)
+ ("`(Α" ?Ἃ)
+ ("´Ἀ" ?Ἄ)
+ ("'Ἀ" ?Ἄ)
+ ("´)Α" ?Ἄ)
+ ("')Α" ?Ἄ)
+ ("´Ἁ" ?á¼)
+ ("'Ἁ" ?á¼)
+ ("´(Α" ?á¼)
+ ("'(Α" ?á¼)
+ ("~Ἀ" ?Ἆ)
+ ("~)Α" ?Ἆ)
+ ("~Ἁ" ?á¼)
+ ("~(Α" ?á¼)
+ (")ε" ?á¼)
+ ("(ε" ?ἑ)
+ ("`á¼" ?á¼’)
+ ("`)ε" ?ἒ)
+ ("`ἑ" ?ἓ)
+ ("`(ε" ?ἓ)
+ ("´á¼" ?á¼”)
+ ("'á¼" ?á¼”)
+ ("´)ε" ?ἔ)
+ ("')ε" ?ἔ)
+ ("´ἑ" ?ἕ)
+ ("'ἑ" ?ἕ)
+ ("´(ε" ?ἕ)
+ ("'(ε" ?ἕ)
+ (")Ε" ?Ἐ)
+ ("(Ε" ?Ἑ)
+ ("`Ἐ" ?Ἒ)
+ ("`)Ε" ?Ἒ)
+ ("`á¼™" ?á¼›)
+ ("`(Ε" ?Ἓ)
+ ("´Ἐ" ?Ἔ)
+ ("'Ἐ" ?Ἔ)
+ ("´)Ε" ?Ἔ)
+ ("')Ε" ?Ἔ)
+ ("´Ἑ" ?á¼)
+ ("'á¼™" ?á¼)
+ ("´(Ε" ?á¼)
+ ("'(Ε" ?á¼)
+ (")η" ?ἠ)
+ ("(η" ?ἡ)
+ ("`á¼ " ?á¼¢)
+ ("`)η" ?ἢ)
+ ("`ἡ" ?ἣ)
+ ("`(η" ?ἣ)
+ ("´ἠ" ?ἤ)
+ ("'ἠ" ?ἤ)
+ ("´)η" ?ἤ)
+ ("')η" ?ἤ)
+ ("´ἡ" ?ἥ)
+ ("'ἡ" ?ἥ)
+ ("´(η" ?ἥ)
+ ("'(η" ?ἥ)
+ ("~ἠ" ?ἦ)
+ ("~)η" ?ἦ)
+ ("~ἡ" ?ἧ)
+ ("~(η" ?ἧ)
+ (")Η" ?Ἠ)
+ ("(Η" ?Ἡ)
+ ("`Ἠ" ?Ἢ)
+ ("`)Η" ?Ἢ)
+ ("`Ἡ" ?Ἣ)
+ ("`(Η" ?Ἣ)
+ ("´Ἠ" ?Ἤ)
+ ("'Ἠ" ?Ἤ)
+ ("´)Η" ?Ἤ)
+ ("')Η" ?Ἤ)
+ ("´Ἡ" ?Ἥ)
+ ("'Ἡ" ?Ἥ)
+ ("´(Η" ?Ἥ)
+ ("'(Η" ?Ἥ)
+ ("~Ἠ" ?Ἦ)
+ ("~)Η" ?Ἦ)
+ ("~Ἡ" ?Ἧ)
+ ("~(Η" ?Ἧ)
+ (")ι" ?ἰ)
+ ("(ι" ?ἱ)
+ ("`á¼°" ?á¼²)
+ ("`)ι" ?ἲ)
+ ("`á¼±" ?á¼³)
+ ("`(ι" ?ἳ)
+ ("´ἰ" ?ἴ)
+ ("'á¼°" ?á¼´)
+ ("´)ι" ?ἴ)
+ ("')ι" ?ἴ)
+ ("´ἱ" ?ἵ)
+ ("'á¼±" ?á¼µ)
+ ("´(ι" ?ἵ)
+ ("'(ι" ?ἵ)
+ ("~á¼°" ?á¼¶)
+ ("~)ι" ?ἶ)
+ ("~á¼±" ?á¼·)
+ ("~(ι" ?ἷ)
+ (")Ι" ?Ἰ)
+ ("(Ι" ?Ἱ)
+ ("`Ἰ" ?Ἲ)
+ ("`)Ι" ?Ἲ)
+ ("`á¼¹" ?á¼»)
+ ("`(Ι" ?Ἳ)
+ ("´Ἰ" ?Ἴ)
+ ("'Ἰ" ?Ἴ)
+ ("´)Ι" ?Ἴ)
+ ("')Ι" ?Ἴ)
+ ("´Ἱ" ?Ἵ)
+ ("'á¼¹" ?á¼½)
+ ("´(Ι" ?Ἵ)
+ ("'(Ι" ?Ἵ)
+ ("~Ἰ" ?Ἶ)
+ ("~)Ι" ?Ἶ)
+ ("~Ἱ" ?Ἷ)
+ ("~(Ι" ?Ἷ)
+ (")ο" ?ὀ)
+ ("(ο" ?á½)
+ ("`ὀ" ?ὂ)
+ ("`)ο" ?ὂ)
+ ("`á½" ?ὃ)
+ ("`(ο" ?ὃ)
+ ("´ὀ" ?ὄ)
+ ("'ὀ" ?ὄ)
+ ("´)ο" ?ὄ)
+ ("')ο" ?ὄ)
+ ("´á½" ?á½…)
+ ("'á½" ?á½…)
+ ("´(ο" ?ὅ)
+ ("'(ο" ?ὅ)
+ (")Ο" ?Ὀ)
+ ("(Ο" ?Ὁ)
+ ("`Ὀ" ?Ὂ)
+ ("`)Ο" ?Ὂ)
+ ("`Ὁ" ?Ὃ)
+ ("`(Ο" ?Ὃ)
+ ("´Ὀ" ?Ὄ)
+ ("'Ὀ" ?Ὄ)
+ ("´)Ο" ?Ὄ)
+ ("')Ο" ?Ὄ)
+ ("´Ὁ" ?á½)
+ ("'Ὁ" ?á½)
+ ("´(Ο" ?á½)
+ ("'(Ο" ?á½)
+ (")Ï…" ?á½)
+ ("(υ" ?ὑ)
+ ("`á½" ?á½’)
+ ("`)Ï…" ?á½’)
+ ("`ὑ" ?ὓ)
+ ("`(υ" ?ὓ)
+ ("´á½" ?á½”)
+ ("'á½" ?á½”)
+ ("´)υ" ?ὔ)
+ ("')Ï…" ?á½”)
+ ("´ὑ" ?ὕ)
+ ("'ὑ" ?ὕ)
+ ("´(υ" ?ὕ)
+ ("'(υ" ?ὕ)
+ ("~á½" ?á½–)
+ ("~)Ï…" ?á½–)
+ ("~ὑ" ?ὗ)
+ ("~(Ï…" ?á½—)
+ ("(Î¥" ?á½™)
+ ("`á½™" ?á½›)
+ ("`(Î¥" ?á½›)
+ ("´Ὑ" ?á½)
+ ("'á½™" ?á½)
+ ("´(Î¥" ?á½)
+ ("'(Î¥" ?á½)
+ ("~Ὑ" ?Ὗ)
+ ("~(Υ" ?Ὗ)
+ (")ω" ?ὠ)
+ ("(ω" ?ὡ)
+ ("`á½ " ?á½¢)
+ ("`)ω" ?ὢ)
+ ("`ὡ" ?ὣ)
+ ("`(ω" ?ὣ)
+ ("´ὠ" ?ὤ)
+ ("'ὠ" ?ὤ)
+ ("´)ω" ?ὤ)
+ ("')ω" ?ὤ)
+ ("´ὡ" ?ὥ)
+ ("'ὡ" ?ὥ)
+ ("´(ω" ?ὥ)
+ ("'(ω" ?ὥ)
+ ("~ὠ" ?ὦ)
+ ("~)ω" ?ὦ)
+ ("~ὡ" ?ὧ)
+ ("~(ω" ?ὧ)
+ (")Ω" ?Ὠ)
+ ("(Ω" ?Ὡ)
+ ("`Ὠ" ?Ὢ)
+ ("`)Ω" ?Ὢ)
+ ("`Ὡ" ?Ὣ)
+ ("`(Ω" ?Ὣ)
+ ("´Ὠ" ?Ὤ)
+ ("'Ὠ" ?Ὤ)
+ ("´)Ω" ?Ὤ)
+ ("')Ω" ?Ὤ)
+ ("´Ὡ" ?Ὥ)
+ ("'Ὡ" ?Ὥ)
+ ("´(Ω" ?Ὥ)
+ ("'(Ω" ?Ὥ)
+ ("~Ὠ" ?Ὦ)
+ ("~)Ω" ?Ὦ)
+ ("~Ὡ" ?Ὧ)
+ ("~(Ω" ?Ὧ)
+ ("`α" ?ὰ)
+ ("`ε" ?ὲ)
+ ("`η" ?ὴ)
+ ("`ι" ?ὶ)
+ ("`ο" ?ὸ)
+ ("`υ" ?ὺ)
+ ("`ω" ?ὼ)
+ ("ιἀ" ?ᾀ)
+ ("ι)α" ?ᾀ)
+ ("ιá¼" ?á¾)
+ ("ι(α" ?á¾)
+ ("ιἂ" ?ᾂ)
+ ("ι`ἀ" ?ᾂ)
+ ("ι`)α" ?ᾂ)
+ ("ιἃ" ?ᾃ)
+ ("ι`á¼" ?ᾃ)
+ ("ι`(α" ?ᾃ)
+ ("ιἄ" ?ᾄ)
+ ("ι´ἀ" ?ᾄ)
+ ("ι'ἀ" ?ᾄ)
+ ("ι´)α" ?ᾄ)
+ ("ι')α" ?ᾄ)
+ ("ιἅ" ?ᾅ)
+ ("ι´á¼" ?á¾…)
+ ("ι'á¼" ?á¾…)
+ ("ι´(α" ?ᾅ)
+ ("ι'(α" ?ᾅ)
+ ("ιἆ" ?ᾆ)
+ ("ι~ἀ" ?ᾆ)
+ ("ι~)α" ?ᾆ)
+ ("ιἇ" ?ᾇ)
+ ("ι~á¼" ?ᾇ)
+ ("ι~(α" ?ᾇ)
+ ("ιἈ" ?ᾈ)
+ ("ι)Α" ?ᾈ)
+ ("ιἉ" ?ᾉ)
+ ("ι(Α" ?ᾉ)
+ ("ιἊ" ?ᾊ)
+ ("ι`Ἀ" ?ᾊ)
+ ("ι`)Α" ?ᾊ)
+ ("ιἋ" ?ᾋ)
+ ("ι`Ἁ" ?ᾋ)
+ ("ι`(Α" ?ᾋ)
+ ("ιἌ" ?ᾌ)
+ ("ι´Ἀ" ?ᾌ)
+ ("ι'Ἀ" ?ᾌ)
+ ("ι´)Α" ?ᾌ)
+ ("ι')Α" ?ᾌ)
+ ("ιá¼" ?á¾)
+ ("ι´Ἁ" ?á¾)
+ ("ι'Ἁ" ?á¾)
+ ("ι´(Α" ?á¾)
+ ("ι'(Α" ?á¾)
+ ("ιἎ" ?ᾎ)
+ ("ι~Ἀ" ?ᾎ)
+ ("ι~)Α" ?ᾎ)
+ ("ιá¼" ?á¾)
+ ("ι~Ἁ" ?á¾)
+ ("ι~(Α" ?á¾)
+ ("ιἠ" ?á¾)
+ ("ι)η" ?á¾)
+ ("ιἡ" ?ᾑ)
+ ("ι(η" ?ᾑ)
+ ("ιἢ" ?ᾒ)
+ ("ι`ἠ" ?ᾒ)
+ ("ι`)η" ?ᾒ)
+ ("ιἣ" ?ᾓ)
+ ("ι`ἡ" ?ᾓ)
+ ("ι`(η" ?ᾓ)
+ ("ιἤ" ?ᾔ)
+ ("ι´ἠ" ?ᾔ)
+ ("ι'ἠ" ?ᾔ)
+ ("ι´)η" ?ᾔ)
+ ("ι')η" ?ᾔ)
+ ("ιἥ" ?ᾕ)
+ ("ι´ἡ" ?ᾕ)
+ ("ι'ἡ" ?ᾕ)
+ ("ι´(η" ?ᾕ)
+ ("ι'(η" ?ᾕ)
+ ("ιἦ" ?ᾖ)
+ ("ι~ἠ" ?ᾖ)
+ ("ι~)η" ?ᾖ)
+ ("ιἧ" ?ᾗ)
+ ("ι~ἡ" ?ᾗ)
+ ("ι~(η" ?ᾗ)
+ ("ιἨ" ?ᾘ)
+ ("ι)Η" ?ᾘ)
+ ("ιἩ" ?ᾙ)
+ ("ι(Η" ?ᾙ)
+ ("ιἪ" ?ᾚ)
+ ("ι`Ἠ" ?ᾚ)
+ ("ι`)Η" ?ᾚ)
+ ("ιἫ" ?ᾛ)
+ ("ι`Ἡ" ?ᾛ)
+ ("ι`(Η" ?ᾛ)
+ ("ιἬ" ?ᾜ)
+ ("ι´Ἠ" ?ᾜ)
+ ("ι'Ἠ" ?ᾜ)
+ ("ι´)Η" ?ᾜ)
+ ("ι')Η" ?ᾜ)
+ ("ιἭ" ?á¾)
+ ("ι´Ἡ" ?á¾)
+ ("ι'Ἡ" ?á¾)
+ ("ι´(Η" ?á¾)
+ ("ι'(Η" ?á¾)
+ ("ιἮ" ?ᾞ)
+ ("ι~Ἠ" ?ᾞ)
+ ("ι~)Η" ?ᾞ)
+ ("ιἯ" ?ᾟ)
+ ("ι~Ἡ" ?ᾟ)
+ ("ι~(Η" ?ᾟ)
+ ("ιὠ" ?ᾠ)
+ ("ι)ω" ?ᾠ)
+ ("ιὡ" ?ᾡ)
+ ("ι(ω" ?ᾡ)
+ ("ιὢ" ?ᾢ)
+ ("ι`ὠ" ?ᾢ)
+ ("ι`)ω" ?ᾢ)
+ ("ιὣ" ?ᾣ)
+ ("ι`ὡ" ?ᾣ)
+ ("ι`(ω" ?ᾣ)
+ ("ιὤ" ?ᾤ)
+ ("ι´ὠ" ?ᾤ)
+ ("ι'ὠ" ?ᾤ)
+ ("ι´)ω" ?ᾤ)
+ ("ι')ω" ?ᾤ)
+ ("ιὥ" ?ᾥ)
+ ("ι´ὡ" ?ᾥ)
+ ("ι'ὡ" ?ᾥ)
+ ("ι´(ω" ?ᾥ)
+ ("ι'(ω" ?ᾥ)
+ ("ιὦ" ?ᾦ)
+ ("ι~ὠ" ?ᾦ)
+ ("ι~)ω" ?ᾦ)
+ ("ιὧ" ?ᾧ)
+ ("ι~ὡ" ?ᾧ)
+ ("ι~(ω" ?ᾧ)
+ ("ιὨ" ?ᾨ)
+ ("ι)Ω" ?ᾨ)
+ ("ιὩ" ?ᾩ)
+ ("ι(Ω" ?ᾩ)
+ ("ιὪ" ?ᾪ)
+ ("ι`Ὠ" ?ᾪ)
+ ("ι`)Ω" ?ᾪ)
+ ("ιὫ" ?ᾫ)
+ ("ι`Ὡ" ?ᾫ)
+ ("ι`(Ω" ?ᾫ)
+ ("ιὬ" ?ᾬ)
+ ("ι´Ὠ" ?ᾬ)
+ ("ι'Ὠ" ?ᾬ)
+ ("ι´)Ω" ?ᾬ)
+ ("ι')Ω" ?ᾬ)
+ ("ιὭ" ?ᾭ)
+ ("ι´Ὡ" ?ᾭ)
+ ("ι'Ὡ" ?ᾭ)
+ ("ι´(Ω" ?ᾭ)
+ ("ι'(Ω" ?ᾭ)
+ ("ιὮ" ?ᾮ)
+ ("ι~Ὠ" ?ᾮ)
+ ("ι~)Ω" ?ᾮ)
+ ("ιὯ" ?ᾯ)
+ ("ι~Ὡ" ?ᾯ)
+ ("ι~(Ω" ?ᾯ)
+ ("Uα" ?ᾰ)
+ ("bα" ?ᾰ)
+ ("¯α" ?ᾱ)
+ ("_α" ?ᾱ)
+ ("ιὰ" ?ᾲ)
+ ("ι`α" ?ᾲ)
+ ("ια" ?ᾳ)
+ ("ιά" ?ᾴ)
+ ("ι´α" ?ᾴ)
+ ("ι'α" ?ᾴ)
+ ("~α" ?ᾶ)
+ ("ιᾶ" ?ᾷ)
+ ("ι~α" ?ᾷ)
+ ("UΑ" ?Ᾰ)
+ ("bΑ" ?Ᾰ)
+ ("¯Α" ?Ᾱ)
+ ("_Α" ?Ᾱ)
+ ("`Α" ?Ὰ)
+ ("ιΑ" ?ᾼ)
+ ("¨~" ?á¿)
+ ("ιὴ" ?ῂ)
+ ("ι`η" ?ῂ)
+ ("ιη" ?ῃ)
+ ("ιή" ?ῄ)
+ ("ι´η" ?ῄ)
+ ("ι'η" ?ῄ)
+ ("~η" ?ῆ)
+ ("ιῆ" ?ῇ)
+ ("ι~η" ?ῇ)
+ ("`Ε" ?Ὲ)
+ ("`Η" ?Ὴ)
+ ("ιΗ" ?ῌ)
+ ("᾿`" ?á¿)
+ ("᾿´" ?῎)
+ ("᾿'" ?῎)
+ ("᾿~" ?á¿)
+ ("Uι" ?á¿)
+ ("bι" ?á¿)
+ ("¯ι" ?ῑ)
+ ("_ι" ?ῑ)
+ ("`ÏŠ" ?á¿’)
+ ("`\"ι" ?ῒ)
+ ("~ι" ?ῖ)
+ ("~ÏŠ" ?á¿—)
+ ("~\"ι" ?ῗ)
+ ("UΙ" ?Ῐ)
+ ("bΙ" ?Ῐ)
+ ("¯Ι" ?Ῑ)
+ ("_Ι" ?Ῑ)
+ ("`Ι" ?Ὶ)
+ ("῾`" ?á¿)
+ ("῾´" ?῞)
+ ("῾'" ?῞)
+ ("῾~" ?῟)
+ ("UÏ…" ?á¿ )
+ ("bÏ…" ?á¿ )
+ ("¯υ" ?ῡ)
+ ("_Ï…" ?á¿¡)
+ ("`Ï‹" ?á¿¢)
+ ("`\"Ï…" ?á¿¢)
+ (")Ï" ?ῤ)
+ ("(Ï" ?á¿¥)
+ ("~υ" ?ῦ)
+ ("~Ï‹" ?á¿§)
+ ("~\"Ï…" ?á¿§)
+ ("UΥ" ?Ῠ)
+ ("bΥ" ?Ῠ)
+ ("¯Υ" ?Ῡ)
+ ("_Î¥" ?á¿©)
+ ("`Υ" ?Ὺ)
+ ("(Ρ" ?Ῥ)
+ ("¨`" ?῭)
+ ("ιὼ" ?ῲ)
+ ("ι`ω" ?ῲ)
+ ("ιω" ?ῳ)
+ ("ιώ" ?ῴ)
+ ("ι´ω" ?ῴ)
+ ("ι'ω" ?ῴ)
+ ("~ω" ?ῶ)
+ ("ιῶ" ?ῷ)
+ ("ι~ω" ?ῷ)
+ ("`Ο" ?Ὸ)
+ ("`Ω" ?Ὼ)
+ ("ιΩ" ?ῼ)
+ ("^0" ?â°)
+ ("^_i" ?â±)
+ ("^_i" ?â±)
+ ("^4" ?â´)
+ ("^5" ?âµ)
+ ("^6" ?â¶)
+ ("^7" ?â·)
+ ("^8" ?â¸)
+ ("^9" ?â¹)
+ ("^+" ?âº)
+ ("^−" ?â»)
+ ("^=" ?â¼)
+ ("^(" ?â½)
+ ("^)" ?â¾)
+ ("^_n" ?â¿)
+ ("^_n" ?â¿)
+ ("_0" ?â‚€)
+ ("_0" ?â‚€)
+ ("_1" ?â‚)
+ ("_1" ?â‚)
+ ("_2" ?â‚‚)
+ ("_2" ?â‚‚)
+ ("_3" ?₃)
+ ("_3" ?₃)
+ ("_4" ?â‚„)
+ ("_4" ?â‚„)
+ ("_5" ?â‚…)
+ ("_5" ?â‚…)
+ ("_6" ?₆)
+ ("_6" ?₆)
+ ("_7" ?₇)
+ ("_7" ?₇)
+ ("_8" ?₈)
+ ("_8" ?₈)
+ ("_9" ?₉)
+ ("_9" ?₉)
+ ("_+" ?₊)
+ ("_+" ?₊)
+ ("_−" ?₋)
+ ("_−" ?₋)
+ ("_=" ?₌)
+ ("_=" ?₌)
+ ("_(" ?â‚)
+ ("_(" ?â‚)
+ ("_)" ?₎)
+ ("_)" ?₎)
+ ("SM" ?â„ )
+ ("sM" ?â„ )
+ ("Sm" ?â„ )
+ ("sm" ?â„ )
+ ("TM" ?â„¢)
+ ("tM" ?â„¢)
+ ("Tm" ?â„¢)
+ ("tm" ?â„¢)
+ ("17" ?â…)
+ ("19" ?â…‘)
+ ("110" ?â…’)
+ ("13" ?â…“)
+ ("23" ?â…”)
+ ("15" ?â…•)
+ ("25" ?â…–)
+ ("35" ?â…—)
+ ("45" ?â…˜)
+ ("16" ?â…™)
+ ("56" ?â…š)
+ ("18" ?â…›)
+ ("38" ?⅜)
+ ("58" ?â…)
+ ("78" ?â…ž)
+ ("03" ?↉)
+ ("/â†" ?↚)
+ ("/→" ?↛)
+ ("/↔" ?↮)
+ ("<-" ?â†)
+ ("->" ?→)
+ ("=>" ?⇒)
+ ("∄" ?∄)
+ ("{}" ?∅)
+ ("∉" ?∉)
+ ("∌" ?∌)
+ ("∤" ?∤)
+ ("∦" ?∦)
+ ("≁" ?â‰)
+ ("≄" ?≄)
+ ("≁" ?≇)
+ ("≉" ?≉)
+ ("/=" ?≠)
+ ("=/" ?≠)
+ ("≠" ?≠)
+ ("≢" ?≢)
+ ("<=" ?≤)
+ (">=" ?≥)
+ ("â‰Ì¸" ?≭)
+ ("≮" ?≮)
+ ("≮" ?≮)
+ ("≯" ?≯)
+ ("≯" ?≯)
+ ("≰" ?≰)
+ ("≱" ?≱)
+ ("≴" ?≴)
+ ("≵" ?≵)
+ ("≸" ?≸)
+ ("≹" ?≹)
+ ("⊀" ?⊀)
+ ("⊁" ?âŠ)
+ ("⊄" ?⊄)
+ ("⊄" ?⊄)
+ ("⊅" ?⊅)
+ ("⊅" ?⊅)
+ ("⊈" ?⊈)
+ ("⊉" ?⊉)
+ ("⊬" ?⊬)
+ ("⊭" ?⊭)
+ ("⊮" ?⊮)
+ ("⊯" ?⊯)
+ ("⋠" ?⋠)
+ ("⋡" ?⋡)
+ ("⋢" ?⋢)
+ ("⋣" ?⋣)
+ ("⋪" ?⋪)
+ ("⋫" ?⋫)
+ ("⋬" ?⋬)
+ ("⋭" ?⋭)
+ ("di" ?⌀)
+ ("(1)" ?â‘ )
+ ("(2)" ?â‘¡)
+ ("(3)" ?â‘¢)
+ ("(4)" ?â‘£)
+ ("(5)" ?⑤)
+ ("(6)" ?â‘¥)
+ ("(7)" ?⑦)
+ ("(8)" ?â‘§)
+ ("(9)" ?⑨)
+ ("(10)" ?â‘©)
+ ("(11)" ?⑪)
+ ("(12)" ?â‘«)
+ ("(13)" ?⑬)
+ ("(14)" ?â‘­)
+ ("(15)" ?â‘®)
+ ("(16)" ?⑯)
+ ("(17)" ?â‘°)
+ ("(18)" ?⑱)
+ ("(19)" ?⑲)
+ ("(20)" ?⑳)
+ ("(A)" ?â’¶)
+ ("(B)" ?â’·)
+ ("(C)" ?â’¸)
+ ("(D)" ?â’¹)
+ ("(E)" ?â’º)
+ ("(F)" ?â’»)
+ ("(G)" ?â’¼)
+ ("(H)" ?â’½)
+ ("(I)" ?â’¾)
+ ("(J)" ?â’¿)
+ ("(K)" ?â“€)
+ ("(L)" ?â“)
+ ("(M)" ?â“‚)
+ ("(N)" ?Ⓝ)
+ ("(O)" ?â“„)
+ ("(P)" ?â“…)
+ ("(Q)" ?Ⓠ)
+ ("(R)" ?Ⓡ)
+ ("(S)" ?Ⓢ)
+ ("(T)" ?Ⓣ)
+ ("(U)" ?Ⓤ)
+ ("(V)" ?â“‹)
+ ("(W)" ?Ⓦ)
+ ("(X)" ?â“)
+ ("(Y)" ?Ⓨ)
+ ("(Z)" ?â“)
+ ("(a)" ?â“)
+ ("(b)" ?â“‘)
+ ("(c)" ?â“’)
+ ("(d)" ?â““)
+ ("(e)" ?â“”)
+ ("(f)" ?â“•)
+ ("(g)" ?â“–)
+ ("(h)" ?â“—)
+ ("(i)" ?ⓘ)
+ ("(j)" ?â“™)
+ ("(k)" ?ⓚ)
+ ("(l)" ?â“›)
+ ("(m)" ?ⓜ)
+ ("(n)" ?â“)
+ ("(o)" ?ⓞ)
+ ("(p)" ?ⓟ)
+ ("(q)" ?â“ )
+ ("(r)" ?â“¡)
+ ("(s)" ?â“¢)
+ ("(t)" ?â“£)
+ ("(u)" ?ⓤ)
+ ("(v)" ?â“¥)
+ ("(w)" ?ⓦ)
+ ("(x)" ?â“§)
+ ("(y)" ?ⓨ)
+ ("(z)" ?â“©)
+ ("(0)" ?⓪)
+ ("â«Ì¸" ?⫝̸)
+ ("^一" ?㆒)
+ ("^二" ?㆓)
+ ("^三" ?㆔)
+ ("^四" ?㆕)
+ ("^上" ?㆖)
+ ("^中" ?㆗)
+ ("^下" ?㆘)
+ ("^甲" ?㆙)
+ ("^乙" ?㆚)
+ ("^丙" ?㆛)
+ ("^ä¸" ?㆜)
+ ("^天" ?ã†)
+ ("^地" ?㆞)
+ ("^人" ?㆟)
+ ("(21)" ?㉑)
+ ("(22)" ?㉒)
+ ("(23)" ?㉓)
+ ("(24)" ?㉔)
+ ("(25)" ?㉕)
+ ("(26)" ?㉖)
+ ("(27)" ?㉗)
+ ("(28)" ?㉘)
+ ("(29)" ?㉙)
+ ("(30)" ?㉚)
+ ("(31)" ?㉛)
+ ("(32)" ?㉜)
+ ("(33)" ?ã‰)
+ ("(34)" ?㉞)
+ ("(35)" ?㉟)
+ ("(ᄀ)" ?㉠)
+ ("(ᄂ)" ?㉡)
+ ("(ᄃ)" ?㉢)
+ ("(ᄅ)" ?㉣)
+ ("(ᄆ)" ?㉤)
+ ("(ᄇ)" ?㉥)
+ ("(ᄉ)" ?㉦)
+ ("(ᄋ)" ?㉧)
+ ("(ᄌ)" ?㉨)
+ ("(ᄎ)" ?㉩)
+ ("(á„)" ?㉪)
+ ("(á„)" ?㉫)
+ ("(ᄑ)" ?㉬)
+ ("(ᄒ)" ?㉭)
+ ("(가)" ?㉮)
+ ("(나)" ?㉯)
+ ("(다)" ?㉰)
+ ("(라)" ?㉱)
+ ("(마)" ?㉲)
+ ("(바)" ?㉳)
+ ("(사)" ?㉴)
+ ("(아)" ?㉵)
+ ("(자)" ?㉶)
+ ("(차)" ?㉷)
+ ("(á„á…¡)" ?㉸)
+ ("(á„á…¡)" ?㉹)
+ ("(파)" ?㉺)
+ ("(하)" ?㉻)
+ ("(一)" ?㊀)
+ ("(二)" ?ãŠ)
+ ("(三)" ?㊂)
+ ("(四)" ?㊃)
+ ("(五)" ?㊄)
+ ("(六)" ?㊅)
+ ("(七)" ?㊆)
+ ("(八)" ?㊇)
+ ("(ä¹)" ?㊈)
+ ("(å)" ?㊉)
+ ("(月)" ?㊊)
+ ("(ç«)" ?㊋)
+ ("(水)" ?㊌)
+ ("(木)" ?ãŠ)
+ ("(金)" ?㊎)
+ ("(土)" ?ãŠ)
+ ("(æ—¥)" ?ãŠ)
+ ("(株)" ?㊑)
+ ("(有)" ?㊒)
+ ("(社)" ?㊓)
+ ("(å)" ?㊔)
+ ("(特)" ?㊕)
+ ("(財)" ?㊖)
+ ("(ç¥)" ?㊗)
+ ("(労)" ?㊘)
+ ("(秘)" ?㊙)
+ ("(男)" ?㊚)
+ ("(女)" ?㊛)
+ ("(é©)" ?㊜)
+ ("(優)" ?ãŠ)
+ ("(å°)" ?㊞)
+ ("(注)" ?㊟)
+ ("(項)" ?㊠)
+ ("(休)" ?㊡)
+ ("(写)" ?㊢)
+ ("(正)" ?㊣)
+ ("(上)" ?㊤)
+ ("(中)" ?㊥)
+ ("(下)" ?㊦)
+ ("(左)" ?㊧)
+ ("(å³)" ?㊨)
+ ("(医)" ?㊩)
+ ("(宗)" ?㊪)
+ ("(学)" ?㊫)
+ ("(監)" ?㊬)
+ ("(ä¼)" ?㊭)
+ ("(資)" ?㊮)
+ ("(å”)" ?㊯)
+ ("(夜)" ?㊰)
+ ("(36)" ?㊱)
+ ("(37)" ?㊲)
+ ("(38)" ?㊳)
+ ("(39)" ?㊴)
+ ("(40)" ?㊵)
+ ("(41)" ?㊶)
+ ("(42)" ?㊷)
+ ("(43)" ?㊸)
+ ("(44)" ?㊹)
+ ("(45)" ?㊺)
+ ("(46)" ?㊻)
+ ("(47)" ?㊼)
+ ("(48)" ?㊽)
+ ("(49)" ?㊾)
+ ("(50)" ?㊿)
+ ("(ã‚¢)" ?ã‹)
+ ("(イ)" ?㋑)
+ ("(ウ)" ?㋒)
+ ("(エ)" ?㋓)
+ ("(オ)" ?㋔)
+ ("(ã‚«)" ?ã‹•)
+ ("(ã‚­)" ?ã‹–)
+ ("(ク)" ?㋗)
+ ("(ケ)" ?㋘)
+ ("(コ)" ?㋙)
+ ("(サ)" ?㋚)
+ ("(ã‚·)" ?ã‹›)
+ ("(ス)" ?㋜)
+ ("(ã‚»)" ?ã‹)
+ ("(ソ)" ?㋞)
+ ("(タ)" ?㋟)
+ ("(ãƒ)" ?ã‹ )
+ ("(ツ)" ?㋡)
+ ("(テ)" ?㋢)
+ ("(ト)" ?㋣)
+ ("(ナ)" ?㋤)
+ ("(ニ)" ?㋥)
+ ("(ヌ)" ?㋦)
+ ("(ãƒ)" ?ã‹§)
+ ("(ノ)" ?㋨)
+ ("(ãƒ)" ?ã‹©)
+ ("(ヒ)" ?㋪)
+ ("(フ)" ?㋫)
+ ("(ヘ)" ?㋬)
+ ("(ホ)" ?㋭)
+ ("(マ)" ?㋮)
+ ("(ミ)" ?㋯)
+ ("(ム)" ?㋰)
+ ("(メ)" ?㋱)
+ ("(モ)" ?㋲)
+ ("(ヤ)" ?㋳)
+ ("(ユ)" ?㋴)
+ ("(ヨ)" ?㋵)
+ ("(ラ)" ?㋶)
+ ("(リ)" ?㋷)
+ ("(ル)" ?㋸)
+ ("(レ)" ?㋹)
+ ("(ロ)" ?㋺)
+ ("(ワ)" ?㋻)
+ ("(ヰ)" ?㋼)
+ ("(ヱ)" ?㋽)
+ ("(ヲ)" ?㋾)
+ ("Ö´×™" ?ï¬)
+ ("ַײ" ?ײַ)
+ ("×ש" ?שׁ)
+ ("ׂש" ?שׂ)
+ ("×ï­‰" ?שּׁ)
+ ("×ּש" ?שּׁ)
+ ("ׂשּ" ?שּׂ)
+ ("ּׂש" ?שּׂ)
+ ("Ö·×" ?אַ)
+ ("Ö¸×" ?אָ)
+ ("Ö¼×" ?אּ)
+ ("ּב" ?בּ)
+ ("ּג" ?גּ)
+ ("ּד" ?דּ)
+ ("ּה" ?הּ)
+ ("ּו" ?וּ)
+ ("ּז" ?זּ)
+ ("ּט" ?טּ)
+ ("ּי" ?יּ)
+ ("ּך" ?ךּ)
+ ("ּכ" ?כּ)
+ ("ּל" ?לּ)
+ ("ּמ" ?מּ)
+ ("Ö¼× " ?ï­€)
+ ("ּס" ?ï­)
+ ("Ö¼×£" ?ï­ƒ)
+ ("ּפ" ?פּ)
+ ("ּצ" ?צּ)
+ ("Ö¼×§" ?ï­‡)
+ ("ּר" ?רּ)
+ ("ּש" ?שּ)
+ ("ּת" ?תּ)
+ ("ֹו" ?וֹ)
+ ("ֿב" ?בֿ)
+ ("Ö¿×›" ?ï­)
+ ("ֿפ" ?פֿ)
+ ("ð…—ð…¥" ?ð…ž)
+ ("ð…˜ð…¥" ?ð…Ÿ)
+ ("ð…Ÿð…®" ?ð… )
+ ("ð…Ÿð…¯" ?ð…¡)
+ ("ð…Ÿð…°" ?ð…¢)
+ ("ð…Ÿð…±" ?ð…£)
+ ("ð…Ÿð…²" ?ð…¤)
+ ("ð†¹ð…¥" ?ð†»)
+ ("ð†ºð…¥" ?ð†¼)
+ ("ð†»ð…®" ?ð†½)
+ ("ð†¼ð…®" ?ð†¾)
+ ("ð†»ð…¯" ?ð†¿)
+ ("ð†¼ð…¯" ?ð‡€)
+ (";S" ?Ș)
+ ("S;" ?Ș)
+ (";s" ?È™)
+ ("s;" ?È™)
+ (";T" ?Èš)
+ ("T;" ?Èš)
+ (";t" ?È›)
+ ("t;" ?È›)
+ ("``а" ["аÌ"])
+ ("`а" ["а̀"])
+ ("´а" ["аÌ"])
+ ("'а" ["аÌ"])
+ ("¯а" ["а̄"])
+ ("_а" ["а̄"])
+ ("^а" ["а̂"])
+ ("``Ð" ["ÐÌ"])
+ ("`Ð" ["ÐÌ€"])
+ ("´Ð" ["ÐÌ"])
+ ("'Ð" ["ÐÌ"])
+ ("¯Ð" ["ÐÌ„"])
+ ("_Ð" ["ÐÌ„"])
+ ("^Ð" ["ÐÌ‚"])
+ ("``е" ["еÌ"])
+ ("´е" ["еÌ"])
+ ("'е" ["еÌ"])
+ ("¯е" ["е̄"])
+ ("_е" ["е̄"])
+ ("^е" ["е̂"])
+ ("``Е" ["ЕÌ"])
+ ("´Е" ["ЕÌ"])
+ ("'Е" ["ЕÌ"])
+ ("¯Е" ["Е̄"])
+ ("_Е" ["Е̄"])
+ ("^Е" ["Е̂"])
+ ("``и" ["иÌ"])
+ ("´и" ["иÌ"])
+ ("'и" ["иÌ"])
+ ("^и" ["и̂"])
+ ("``И" ["ИÌ"])
+ ("´И" ["ИÌ"])
+ ("'И" ["ИÌ"])
+ ("^И" ["И̂"])
+ ("``о" ["оÌ"])
+ ("`о" ["о̀"])
+ ("´о" ["оÌ"])
+ ("'о" ["оÌ"])
+ ("¯о" ["о̄"])
+ ("_о" ["о̄"])
+ ("^о" ["о̂"])
+ ("``О" ["ОÌ"])
+ ("`О" ["О̀"])
+ ("´О" ["ОÌ"])
+ ("'О" ["ОÌ"])
+ ("¯О" ["О̄"])
+ ("_О" ["О̄"])
+ ("^О" ["О̂"])
+ ("``у" ["уÌ"])
+ ("`у" ["у̀"])
+ ("´у" ["уÌ"])
+ ("'у" ["уÌ"])
+ ("^у" ["у̂"])
+ ("``У" ["УÌ"])
+ ("`У" ["У̀"])
+ ("´У" ["УÌ"])
+ ("'У" ["УÌ"])
+ ("^У" ["У̂"])
+ ("``Ñ€" ["Ñ€Ì"])
+ ("`р" ["р̀"])
+ ("´р" ["Ñ€Ì"])
+ ("'Ñ€" ["Ñ€Ì"])
+ ("¯р" ["р̄"])
+ ("_р" ["р̄"])
+ ("^р" ["р̂"])
+ ("``Р" ["РÌ"])
+ ("`Р" ["Р̀"])
+ ("´Р" ["РÌ"])
+ ("'Р" ["РÌ"])
+ ("¯Р" ["Р̄"])
+ ("_Р" ["Р̄"])
+ ("^Р" ["Р̂"])
+ ("v/" ?√)
+ ("/v" ?√)
+ ("88" ?∞)
+ ("=_" ?≡)
+ ("_≠" ?≢)
+ ("≠_" ?≢)
+ ("<_" ?≤)
+ ("_<" ?≤)
+ (">_" ?≥)
+ ("_>" ?≥)
+ ("_⊂" ?⊆)
+ ("⊂_" ?⊆)
+ ("_⊃" ?⊇)
+ ("⊃_" ?⊇)
+ ("○-" ?⊖)
+ ("-○" ?⊖)
+ ("○." ?⊙)
+ (".○" ?⊙)
+ ("<>" ?â‹„)
+ ("><" ?â‹„)
+ ("∧∨" ?⋄)
+ ("∨∧" ?⋄)
+ (":." ?∴)
+ (".:" ?∵)
+ ("⊥⊤" ?⌶)
+ ("⊤⊥" ?⌶)
+ ("[]" ?⌷)
+ ("][" ?⌷)
+ ("⎕=" ?⌸)
+ ("=⎕" ?⌸)
+ ("⎕÷" ?⌹)
+ ("÷⎕" ?⌹)
+ ("⎕⋄" ?⌺)
+ ("⋄⎕" ?⌺)
+ ("⎕∘" ?⌻)
+ ("∘⎕" ?⌻)
+ ("⎕○" ?⌼)
+ ("○⎕" ?⌼)
+ ("○|" ?⌽)
+ ("|○" ?⌽)
+ ("○∘" ?⌾)
+ ("∘○" ?⌾)
+ ("/-" ?⌿)
+ ("-/" ?⌿)
+ ("\\-" ?â€)
+ ("-\\" ?â€)
+ ("/⎕" ?â)
+ ("⎕/" ?â)
+ ("\\⎕" ?â‚)
+ ("⎕\\" ?â‚)
+ ("<⎕" ?âƒ)
+ ("⎕<" ?âƒ)
+ (">⎕" ?â„)
+ ("⎕>" ?â„)
+ ("â†|" ?â…)
+ ("|â†" ?â…)
+ ("→|" ?â†)
+ ("|→" ?â†)
+ ("â†âŽ•" ?â‡)
+ ("⎕â†" ?â‡)
+ ("→⎕" ?âˆ)
+ ("⎕→" ?âˆ)
+ ("â—‹\\" ?â‰)
+ ("\\â—‹" ?â‰)
+ ("_⊥" ?âŠ)
+ ("⊥_" ?âŠ)
+ ("∆|" ?â‹)
+ ("|∆" ?â‹)
+ ("∨⎕" ?âŒ)
+ ("⎕∨" ?âŒ)
+ ("∆⎕" ?â)
+ ("⎕∆" ?â)
+ ("∘⊥" ?âŽ)
+ ("⊥∘" ?âŽ)
+ ("↑-" ?â)
+ ("-↑" ?â)
+ ("↑⎕" ?â)
+ ("⎕↑" ?â)
+ ("¯⊤" ?â‘)
+ ("⊤¯" ?â‘)
+ ("∇|" ?â’)
+ ("|∇" ?â’)
+ ("∧⎕" ?â“)
+ ("⎕∧" ?â“)
+ ("∇⎕" ?â”)
+ ("⎕∇" ?â”)
+ ("∘⊤" ?â•)
+ ("⊤∘" ?â•)
+ ("↓-" ?â–)
+ ("-↓" ?â–)
+ ("↓⎕" ?â—)
+ ("⎕↓" ?â—)
+ ("_'" ?â˜)
+ ("∆_" ?â™)
+ ("_∆" ?â™)
+ ("â‹„_" ?âš)
+ ("_â‹„" ?âš)
+ ("∘_" ?â›)
+ ("_∘" ?â›)
+ ("â—‹_" ?âœ)
+ ("_â—‹" ?âœ)
+ ("∘∩" ?â)
+ ("∩∘" ?â)
+ ("⎕'" ?âž)
+ ("'⎕" ?âž)
+ ("â—‹*" ?âŸ)
+ ("*â—‹" ?âŸ)
+ (":⎕" ?â )
+ ("⎕:" ?â )
+ ("¨⊤" ?â¡)
+ ("⊤¨" ?â¡)
+ ("¨∇" ?â¢)
+ ("∇¨" ?â¢)
+ ("*¨" ?â£)
+ ("¨*" ?â£)
+ ("∘¨" ?â¤)
+ ("¨∘" ?â¤)
+ ("○¨" ?â¥)
+ ("¨○" ?â¥)
+ ("∪|" ?â¦)
+ ("|∪" ?â¦)
+ ("⊂|" ?â§)
+ ("|⊂" ?â§)
+ ("~¨" ?â¨)
+ ("¨>" ?â©)
+ (">¨" ?â©)
+ ("∇~" ?â«)
+ ("~∇" ?â«)
+ ("0~" ?â¬)
+ ("~0" ?â¬)
+ ("|~" ?â­)
+ ("~|" ?â­)
+ (";_" ?â®)
+ ("≠⎕" ?â¯)
+ ("⎕≠" ?â¯)
+ ("?⎕" ?â°)
+ ("⎕?" ?â°)
+ ("∨~" ?â±)
+ ("~∨" ?â±)
+ ("∧~" ?â²)
+ ("~∧" ?â²)
+ ("âº_" ?â¶)
+ ("_âº" ?â¶)
+ ("∊_" ?â·)
+ ("_∊" ?â·)
+ ("â³_" ?â¸)
+ ("_â³" ?â¸)
+ ("âµ_" ?â¹)
+ ("_âµ" ?â¹)
+ )
+
+;; Quail package `iso-transl' is based on `C-x 8' key sequences.
+;; This input method supports the same key sequences as defined
+;; by the `C-x 8' keymap in iso-transl.el.
+
+(quail-define-package
+ "iso-transl" "UTF-8" "X8" t
+ "Use the same key sequences as in `C-x 8' keymap defined in iso-transl.el.
+Examples:
+ * E -> € 1 / 2 -> ½ ^ 3 -> ³"
+ '(("\t" . quail-completion))
+ t nil nil nil nil nil nil nil nil t)
+
+(eval-when-compile
+ (require 'iso-transl)
+ (defmacro iso-transl--define-rules ()
+ `(quail-define-rules
+ ,@(mapcar (lambda (rule)
+ (let ((from (car rule))
+ (to (cdr rule)))
+ (list from (if (stringp to)
+ (vector to)
+ to))))
+ iso-transl-char-map))))
+
+(iso-transl--define-rules)
+
+(provide 'compose)
+;;; compose.el ends here
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 2681eab0e5e..100ae63f6ac 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -117,6 +117,7 @@
indian-knd-itrans-v5-hash "kannada-itrans" "Kannada" "KndIT"
"Kannada transliteration by ITRANS method.")
+;; ITRANS not applicable to Malayalam & could be removed eventually
(if nil
(quail-define-package "malayalam-itrans" "Malayalam" "MlmIT" t "Malayalam ITRANS"))
(quail-define-indian-trans-package
@@ -358,24 +359,23 @@ Full key sequences are listed below:")
'(
(;; VOWELS (18)
(?D nil) (?E ?e) (?F ?f) (?R ?r) (?G ?g) (?T ?t)
- (?+ ?=) ("F]" "f]") (?! ?@) (?S ?s) (?Z ?z) (?W ?w)
- (?| ?\\) (?~ ?`) (?A ?a) (?Q ?q) ("+]" "=]") ("R]" "r]"))
+ (?= ?+) nil nil (?S ?s) (?Z ?z) (?W ?w)
+ nil (?~ ?`) (?A ?a) (?Q ?q))
(;; CONSONANTS (42)
?k ?K ?i ?I ?U ;; GRUTTALS
?\; ?: ?p ?P ?} ;; PALATALS
?' ?\" ?\[ ?{ ?C ;; CEREBRALS
- ?l ?L ?o ?O ?v ?V ;; DENTALS
+ ?l ?L ?o ?O ?v nil ;; DENTALS
?h ?H ?y ?Y ?c ;; LABIALS
- ?/ ?j ?J ?n ?N "N]" ?b ;; SEMIVOWELS
+ ?/ ?j ?J ?n ?N ?B ?b ;; SEMIVOWELS
?M ?< ?m ?u ;; SIBILANTS
- "k]" "K]" "i]" "p]" "[]" "{]" "H]" "/]" ;; NUKTAS
- ?% ?&)
+ nil nil nil nil nil nil nil nil nil) ;; NUKTAS
(;; Misc Symbols (7)
- ?X ?x ?_ ">]" ?d "X]" ?>)
+ nil ?x ?_ nil ?d)
(;; Digits
?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
- (;; Inscripts
- ?# ?$ ?^ ?* ?\])))
+ (;; Chillus
+ "Cd" "Cd]" "vd" "vd]" "jd" "jd]" "nd" "nd]" "Nd" "Nd]")))
(defvar inscript-tml-keytable
'(
@@ -463,6 +463,9 @@ Full key sequences are listed below:")
"malayalam-inscript" "Malayalam" "MlmIS"
"Malayalam keyboard Inscript.")
+(quail-defrule "\\" ?‌)
+(quail-defrule "X" ?​)
+
(if nil
(quail-define-package "tamil-inscript" "Tamil" "TmlIS" t "Tamil keyboard Inscript"))
(quail-define-inscript-package
@@ -571,4 +574,72 @@ Full key sequences are listed below:")
("?" ?\?)
("/" ?à§))
+(defun indian-mlm-mozhi-update-translation (control-flag)
+ (let ((len (length quail-current-key)) chillu
+ (vowels '(?a ?e ?i ?o ?u ?A ?E ?I ?O ?U ?R)))
+ (cond ((numberp control-flag)
+ (progn (if (= control-flag 0)
+ (setq quail-current-str quail-current-key)
+ (cond (input-method-exit-on-first-char)
+ ((and (memq (aref quail-current-key
+ (1- control-flag))
+ vowels)
+ (setq chillu (cl-position
+ (aref quail-current-key
+ control-flag)
+ '(?m ?N ?n ?r ?l ?L))))
+ ;; conditions for putting chillu
+ (and (or (and (= control-flag (1- len))
+ (not (setq control-flag nil)))
+ (and (= control-flag (- len 2))
+ (let ((temp (aref quail-current-key
+ (1- len))))
+ ;; is it last char of word?
+ (not
+ (or (and (>= temp ?a) (<= temp ?z))
+ (and (>= temp ?A) (<= temp ?Z))
+ (eq temp ?~))))
+ (setq control-flag (1+ control-flag))))
+ (setq quail-current-str ;; put chillu
+ (concat (if (not (stringp
+ quail-current-str))
+ (string quail-current-str)
+ quail-current-str)
+ (string
+ (nth chillu '(?ം ?ൺ ?ൻ ?ർ ?ൽ ?ൾ)))))))))
+ (and (not input-method-exit-on-first-char) control-flag
+ (while (> len control-flag)
+ (setq len (1- len))
+ (setq unread-command-events
+ (cons (aref quail-current-key len)
+ unread-command-events))))
+ ))
+ ((null control-flag)
+ (unless quail-current-str
+ (setq quail-current-str quail-current-key)
+ ))
+ ((equal control-flag t)
+ (if (memq (aref quail-current-key (1- len)) ;; If vowel ending,
+ vowels) ;; may have to put
+ (setq control-flag nil))))) ;; chillu. So don't
+ control-flag) ;; end translation
+
+(quail-define-package "malayalam-mozhi" "Malayalam" "MlmMI" t
+ "Malayalam transliteration by Mozhi method."
+ nil nil t nil nil nil t nil
+ 'indian-mlm-mozhi-update-translation)
+
+(maphash
+ (lambda (key val)
+ (quail-defrule key (if (= (length val) 1)
+ (string-to-char val)
+ (vector val))))
+ (cdr indian-mlm-mozhi-hash))
+
+(defun indian-mlm-mozhi-underscore (key len) (throw 'quail-tag nil))
+
+(quail-defrule "_" 'indian-mlm-mozhi-underscore)
+(quail-defrule "|" ?‌)
+(quail-defrule "||" ?​)
+
;;; indian.el ends here
diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el
index d4170564c58..cbc555d1faa 100644
--- a/lisp/leim/quail/ipa.el
+++ b/lisp/leim/quail/ipa.el
@@ -340,7 +340,7 @@ See http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf for a full definition
of the mapping.")
(quail-define-rules
- ;; Table taken from http://en.wikipedia.org/wiki/X-SAMPA, checked with
+ ;; Table taken from https://en.wikipedia.org/wiki/X-SAMPA, checked with
;; http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf
("d`" "É–") ;; Voiced retroflex plosive U+0256
diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el
index 35a9adbe29b..f1a24bbd5fe 100644
--- a/lisp/leim/quail/latin-ltx.el
+++ b/lisp/leim/quail/latin-ltx.el
@@ -8,7 +8,7 @@
;; Author: TAKAHASHI Naoto <ntakahas@m17n.org>
;; Dave Love <fx@gnu.org>
-;; Keywords: multilingual, input, Greek, i18n
+;; Keywords: multilingual, input method, i18n
;; This file is part of GNU Emacs.
@@ -242,12 +242,14 @@ system, including many technical ones. Examples:
((lambda (name char)
;; "GREEK SMALL LETTER PHI" (which is \phi) and "GREEK PHI SYMBOL"
;; (which is \varphi) are reversed in `ucs-names', so we define
- ;; them manually.
- (unless (string-match-p "\\<PHI\\>" name)
+ ;; them manually. Also ignore "GREEK SMALL LETTER EPSILON" and
+ ;; add the correct value for \epsilon manually.
+ (unless (string-match-p "\\<\\(?:PHI\\|GREEK SMALL LETTER EPSILON\\)\\>" name)
(concat "\\" (funcall (if (match-end 1) #' capitalize #'downcase)
(match-string 2 name)))))
"\\`GREEK \\(?:SMALL\\|CAPITA\\(L\\)\\) LETTER \\([^- ]+\\)\\'")
+ ("\\epsilon" ?ϵ)
("\\phi" ?Ï•)
("\\Box" ?â–¡)
("\\Bumpeq" ?≎)
@@ -641,6 +643,7 @@ system, including many technical ones. Examples:
(concat "\\var" (downcase (match-string 1 name)))))
"\\`GREEK \\([^- ]+\\) SYMBOL\\'")
+ ("\\varepsilon" ?ε)
("\\varphi" ?φ)
("\\varprime" ?′)
("\\varpropto" ?âˆ)
@@ -727,7 +730,9 @@ system, including many technical ones. Examples:
("\\ldq" ?\“)
("\\rdq" ?\â€)
("\\defs" ?≙) ; per fuzz/zed
- ;; ("\\sqrt[3]" ?∛)
+ ("\\sqrt" ?√)
+ ("\\sqrt[3]" ?∛)
+ ("\\sqrt[4]" ?∜)
("\\llbracket" ?\〚) ; stmaryrd
("\\rrbracket" ?\〛)
;; ("\\lbag" ?\〚) ; fuzz
diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el
index a033739efba..1d6aeddc060 100644
--- a/lisp/leim/quail/latin-post.el
+++ b/lisp/leim/quail/latin-post.el
@@ -937,7 +937,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
(quail-define-package
"danish-postfix" "Latin-1" "DA<" t
- "Danish input method (rule: AE -> Æ, OE -> Ø, AA -> Å, E\\=' -> É)
+ "Danish input method (rule: AE -> Æ, OE -> Ø, AA -> Å, E\\=' -> É, E= -> €)
Doubling the postfix separates the letter and postfix: e.g. aee -> ae
"
@@ -951,6 +951,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae
("AA" ?Ã…)
("aa" ?Ã¥)
("E'" ?É)
+ ("E=" ?€)
("e'" ?é)
("AEE" ["AE"])
@@ -960,6 +961,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae
("AAA" ["AA"])
("aaa" ["aa"])
("E''" ["E'"])
+ ("E==" ["E="])
("e''" ["e'"])
)
@@ -1034,6 +1036,7 @@ AE -> Ä
AEE -> AE
OE -> Ö
OEE -> OE
+E= -> €
"
nil t nil nil nil nil nil nil nil nil t)
@@ -1042,11 +1045,13 @@ OEE -> OE
("ae" ?ä)
("OE" ?Ö)
("oe" ?ö)
+ ("E=" ?€)
("AEE" ["AE"])
("aee" ["ae"])
("OEE" ["OE"])
("oee" ["oe"])
+ ("E==" ["E="])
)
(quail-define-package
@@ -1061,6 +1066,8 @@ Par exemple: a\\=` -> à e\\=' -> é.
En doublant la frappe des diacritiques, ils s'isoleront de la lettre.
Par exemple: e\\='\\=' -> e\\='
+€ est produit par E=.
+
Å’ est produit par O/."
nil t nil nil nil nil nil nil nil nil t)
@@ -1073,6 +1080,7 @@ Par exemple: e\\='\\=' -> e\\='
("E'" ?É)
("E^" ?Ê)
("E\"" ?Ë)
+ ("E=" ?€)
("e`" ?è)
("e'" ?é)
("e^" ?ê)
@@ -1104,6 +1112,7 @@ Par exemple: e\\='\\=' -> e\\='
("E''" ["E'"])
("E^^" ["E^"])
("E\"\"" ["E\""])
+ ("E==" ["E="])
("e``" ["e`"])
("e''" ["e'"])
("e^^" ["e^"])
@@ -1140,6 +1149,7 @@ ue -> ü (not after a/e/q)
uee -> ue
sz -> ß
szz -> sz
+E= -> €
"
nil t nil nil nil nil nil nil nil nil t)
@@ -1152,6 +1162,7 @@ szz -> sz
("ue" ?ü)
("sz" ?ß)
("SZ" ?ẞ)
+ ("E=" ?€)
("AEE" ["AE"])
("aee" ["ae"])
@@ -1168,6 +1179,7 @@ szz -> sz
("Aue" ["Aue"])
("que" ["que"])
("Que" ["Que"])
+ ("E==" ["E="])
)
(quail-define-package
@@ -1184,6 +1196,7 @@ AE -> Æ
OE -> Ö
D/ -> Ã (eth)
T/ -> Þ (thorn)
+E= -> €
Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
" nil t nil nil nil nil nil nil nil nil t)
@@ -1238,7 +1251,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
a\\=` -> à A\\=` -> À e\\=' -> é << -> «
e\\=` -> è E\\=` -> È E\\=' -> É >> -> »
-i\\=` -> ì I\\=` -> Ì o_ -> º
+i\\=` -> ì I\\=` -> Ì E= -> € o_ -> º
o\\=` -> ò O\\=` -> Ò a_ -> ª
u\\=` -> ù U\\=` -> Ù
@@ -1252,6 +1265,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\=`\\=` -> a\\=`
("a`" ?à)
("E`" ?È)
("E'" ?É)
+ ("E=" ?€)
("e`" ?è)
("e'" ?é)
("I`" ?Ì)
@@ -1269,6 +1283,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\=`\\=` -> a\\=`
("a``" ["a`"])
("E``" ["E`"])
("E''" ["E'"])
+ ("E==" ["E="])
("e``" ["e`"])
("e''" ["e'"])
("I``" ["I`"])
@@ -1285,7 +1300,8 @@ Doubling the postfix separates the letter and postfix: e.g. a\\=`\\=` -> a\\=`
(quail-define-package
"norwegian-postfix" "Latin-1" "NO<" t
- "Norwegian (Norsk) input method (rule: AE->Æ OE->Ø AA->Å E\\='->É)
+ "Norwegian (Norsk) input method (rule: AE->Æ OE->Ø AA->Å E\\='->É
+ E= -> €)
Doubling the postfix separates the letter and postfix: e.g. aee -> ae
"
@@ -1299,6 +1315,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae
("AA" ?Ã…)
("aa" ?Ã¥)
("E'" ?É)
+ ("E=" ?€)
("e'" ?é)
("AEE" ["AE"])
@@ -1308,6 +1325,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae
("AAA" ["AA"])
("aaa" ["aa"])
("E''" ["E'"])
+ ("E==" ["E="])
("e''" ["e'"])
)
@@ -1322,6 +1340,7 @@ aa -> å
a\" -> ä
o\" -> ö
e\\=' -> é
+E= -> €
Doubling the postfix separates the letter and postfix:
aee -> ae o\"\" -> o\" etc.
@@ -1339,6 +1358,7 @@ aee -> ae o\"\" -> o\" etc.
("O\"" ?Ö)
("o\"" ?ö)
("E'" ?É)
+ ("E=" ?€)
("e'" ?é)
("AEE" ["AE"])
@@ -1352,6 +1372,7 @@ aee -> ae o\"\" -> o\" etc.
("O\"\"" ["O\""])
("o\"\"" ["o\""])
("E''" ["E'"])
+ ("E==" ["E="])
("e''" ["e'"])
)
@@ -1361,6 +1382,7 @@ aee -> ae o\"\" -> o\" etc.
A\\=' -> Ã
E\\=' -> É
+E= -> €
I\\=' -> Ã
O\\=' -> Ó
U\\=' -> Ú
@@ -1376,6 +1398,7 @@ a\\='\\=' -> a\\=' n~~ -> n~, etc.
("A'" ?Ã)
("a'" ?á)
("E'" ?É)
+ ("E=" ?€)
("e'" ?é)
("I'" ?Ã)
("i'" ?í)
@@ -1393,6 +1416,7 @@ a\\='\\=' -> a\\=' n~~ -> n~, etc.
("A''" ["A'"])
("a''" ["a'"])
("E''" ["E'"])
+ ("E==" ["E="])
("e''" ["e'"])
("I''" ["I'"])
("i''" ["i'"])
@@ -1410,7 +1434,8 @@ a\\='\\=' -> a\\=' n~~ -> n~, etc.
(quail-define-package
"swedish-postfix" "Latin-1" "SV<" t
- "Swedish (Svenska) input method (rule: AA -> Å AE -> Ä OE -> Ö E\\=' -> É)
+ "Swedish (Svenska) input method
+(rule: AA -> Å AE -> Ä OE -> Ö E\\=' -> É E= -> €)
Doubling the postfix separates the letter and postfix: e.g. aee -> ae
" nil t nil nil nil nil nil nil nil nil t)
@@ -1423,6 +1448,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae
("OE" ?Ö)
("oe" ?ö)
("E'" ?É)
+ ("E=" ?€)
("e'" ?é)
("AAA" ["AA"])
@@ -1432,6 +1458,7 @@ Doubling the postfix separates the letter and postfix: e.g. aee -> ae
("OEE" ["OE"])
("oee" ["oe"])
("E''" ["E'"])
+ ("E==" ["E="])
("e''" ["e'"])
)
diff --git a/lisp/linum.el b/lisp/linum.el
index 8f0e7ddce4d..e8c364245ae 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -5,7 +5,7 @@
;; Author: Markus Triska <markus.triska@gmx.at>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
-;; Version: 0.9x
+;; Old-Version: 0.9x
;; This file is part of GNU Emacs.
@@ -32,6 +32,7 @@
;;; Code:
(defconst linum-version "0.9x")
+(make-obsolete-variable 'linum-version nil "28.1")
(defvar linum-overlays nil "Overlays used in this buffer.")
(defvar linum-available nil "Overlays available for reuse.")
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index a1ff2f6270d..8ac575e8e39 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -234,11 +234,10 @@ If the feature is required by any other loaded code, and prefix arg FORCE
is nil, raise an error.
Standard unloading activities include restoring old autoloads for
-functions defined by the library, undoing any additions that the
-library has made to hook variables or to `auto-mode-alist', undoing
-ELP profiling of functions in that library, unproviding any features
-provided by the library, and canceling timers held in variables
-defined by the library.
+functions defined by the library, removing such functions from
+hooks and `auto-mode-alist', undoing their ELP profiling,
+unproviding any features provided by the library, and canceling
+timers held in variables defined by the library.
If a function `FEATURE-unload-function' is defined, this function
calls it with no arguments, before doing anything else. That function
@@ -287,22 +286,32 @@ something strange, such as redefining an Emacs function."
;; functions which the package might just have installed, and
;; there might be other important state, but this tactic
;; normally works.
- (mapatoms
- (lambda (x)
- (when (and (boundp x)
- (or (and (consp (symbol-value x)) ; Random hooks.
- (string-match "-hooks?\\'" (symbol-name x)))
- (memq x unload-feature-special-hooks))) ; Known abnormal hooks etc.
- (dolist (y unload-function-defs-list)
- (when (and (eq (car-safe y) 'defun)
- (not (get (cdr y) 'autoload)))
- (remove-hook x (cdr y)))))))
- ;; Remove any feature-symbols from auto-mode-alist as well.
- (dolist (y unload-function-defs-list)
- (when (and (eq (car-safe y) 'defun)
- (not (get (cdr y) 'autoload)))
- (setq auto-mode-alist
- (rassq-delete-all (cdr y) auto-mode-alist)))))
+ (let ((removables (cl-loop for def in unload-function-defs-list
+ when (and (eq (car-safe def) 'defun)
+ (not (get (cdr def) 'autoload)))
+ collect (cdr def))))
+ (mapatoms
+ (lambda (x)
+ (when (and (boundp x)
+ (or (and (consp (symbol-value x)) ; Random hooks.
+ (string-match "-hooks?\\'" (symbol-name x)))
+ ;; Known abnormal hooks etc.
+ (memq x unload-feature-special-hooks)))
+ (dolist (func removables)
+ (remove-hook x func)))))
+ (save-current-buffer
+ (dolist (buffer (buffer-list))
+ (pcase-dolist (`(,sym . ,val) (buffer-local-variables buffer))
+ (when (or (and (consp val)
+ (string-match "-hooks?\\'" (symbol-name sym)))
+ (memq sym unload-feature-special-hooks))
+ (set-buffer buffer)
+ (dolist (func removables)
+ (remove-hook sym func t))))))
+ ;; Remove any feature-symbols from auto-mode-alist as well.
+ (dolist (func removables)
+ (setq auto-mode-alist
+ (rassq-delete-all func auto-mode-alist)))))
;; Change major mode in all buffers using one defined in the feature being unloaded.
(unload--set-major-mode)
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 97525b27086..4b711eed065 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -57,7 +57,7 @@
;; bidi.c needs for its job.
(setq redisplay--inhibit-bidi t)
-(message "dump mode: %s" dump-mode)
+(message "Dump mode: %s" dump-mode)
;; Add subdirectories to the load-path for files that might get
;; autoloaded when bootstrapping or running Emacs normally.
@@ -170,7 +170,6 @@
(load "cus-face")
(load "faces") ; after here, `defface' may be used.
-(load "button")
;; We don't want to store loaddefs.el in the repository because it is
;; a generated file; but it is required in order to compile the lisp files.
@@ -193,6 +192,7 @@
definition-prefixes)
(setq definition-prefixes new))
+(load "button") ;After loaddefs, because of define-minor-mode!
(load "emacs-lisp/nadvice")
(load "emacs-lisp/cl-preloaded")
(load "obarray") ;abbrev.el is implemented in terms of obarrays.
diff --git a/lisp/locate.el b/lisp/locate.el
index 9f402716d02..44a67ab4840 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -267,9 +267,7 @@ that is, with a prefix arg, you get the default behavior."
(let* ((default (locate-word-at-point))
(input
(read-from-minibuffer
- (if (> (length default) 0)
- (format "Locate (default %s): " default)
- (format "Locate: "))
+ (format-prompt "Locate" default)
nil nil nil 'locate-history-list default t)))
(and (equal input "") default
(setq input default))
@@ -670,11 +668,11 @@ the database on the command line."
(or (file-exists-p database)
(error "Database file %s does not exist" database))
(let ((locate-make-command-line
- (function (lambda (string)
- (cons locate-command
- (list (concat "--database="
- (expand-file-name database))
- string))))))
+ (lambda (string)
+ (cons locate-command
+ (list (concat "--database="
+ (expand-file-name database))
+ string)))))
(locate search-string)))
(defun locate-do-redisplay (&optional arg test-for-subdir)
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 2952242c251..e2646209313 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -435,9 +435,9 @@ not contain `d', so that a full listing is expected."
;; text. But if the listing is empty, as e.g. in empty
;; directories with -a removed from switches, point will be
;; before the inserted text, and dired-insert-directory will
- ;; not indent the listing correctly. Going to the end of the
- ;; buffer fixes that.
- (unless files (goto-char (point-max)))
+ ;; not indent the listing correctly. Getting past the
+ ;; inserted text solves this.
+ (unless (cdr total-line) (forward-line 2))
(if (memq ?R switches)
;; List the contents of all directories recursively.
;; cadr of each element of `file-alist' is t for
@@ -836,6 +836,9 @@ Return nil if no time switch found."
((memq ?t switches) 5) ; last modtime
((memq ?u switches) 4))) ; last access
+(defvar ls-lisp--time-locale nil
+ "Locale to be used for formatting file times.")
+
(defun ls-lisp-format-time (file-attr time-index)
"Format time for file with attributes FILE-ATTR according to TIME-INDEX.
Use the same method as ls to decide whether to show time-of-day or year,
@@ -851,11 +854,13 @@ All ls time options, namely c, t and u, are handled."
(condition-case nil
;; Use traditional time format in the C or POSIX locale,
;; ISO-style time format otherwise, so columns line up.
- (let ((locale system-time-locale))
+ (let ((locale (or system-time-locale ls-lisp--time-locale)))
(if (not locale)
(let ((vars '("LC_ALL" "LC_TIME" "LANG")))
(while (and vars (not (setq locale (getenv (car vars)))))
- (setq vars (cdr vars)))))
+ (setq vars (cdr vars)))
+ ;; Cache the locale for next calls.
+ (setq ls-lisp--time-locale (or locale "C"))))
(if (member locale '("C" "POSIX"))
(setq locale nil))
(format-time-string
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index 896f82d7bcc..035bb32fa12 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -29,12 +29,6 @@
;;; Code:
-(eval-and-compile
- (defalias 'binhex-char-int
- (if (fboundp 'char-int)
- 'char-int
- 'identity)))
-
(defgroup binhex nil
"Decoding of BinHex (binary-to-hexadecimal) data."
:group 'mail
@@ -83,10 +77,8 @@ input and write the converted data to its standard output."
"^[^:]...............................................................$")
(defconst binhex-end-line ":$") ; unused
-(defvar binhex-temporary-file-directory
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp/")))
+(make-obsolete-variable 'binhex-temporary-file-directory
+ 'temporary-file-directory "28.1")
(defun binhex-insert-char (char &optional count ignored buffer)
"Insert COUNT copies of CHARACTER into BUFFER."
@@ -152,14 +144,14 @@ input and write the converted data to its standard output."
(defun binhex-string-big-endian (string)
(let ((ret 0) (i 0) (len (length string)))
(while (< i len)
- (setq ret (+ (ash ret 8) (binhex-char-int (aref string i)))
+ (setq ret (+ (ash ret 8) (aref string i))
i (1+ i)))
ret))
(defun binhex-string-little-endian (string)
(let ((ret 0) (i 0) (shift 0) (len (length string)))
(while (< i len)
- (setq ret (+ ret (ash (binhex-char-int (aref string i)) shift))
+ (setq ret (+ ret (ash (aref string i) shift))
i (1+ i)
shift (+ shift 8)))
ret))
@@ -169,11 +161,11 @@ input and write the converted data to its standard output."
(let ((pos (point-min)) len)
(vector
(prog1
- (setq len (binhex-char-int (char-after pos)))
+ (setq len (char-after pos))
(setq pos (1+ pos)))
(buffer-substring pos (setq pos (+ pos len)))
(prog1
- (setq len (binhex-char-int (char-after pos)))
+ (setq len (char-after pos))
(setq pos (1+ pos)))
(buffer-substring pos (setq pos (+ pos 4)))
(buffer-substring pos (setq pos (+ pos 4)))
@@ -285,7 +277,7 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(file-name (expand-file-name
(concat (binhex-decode-region-internal start end t)
".data")
- binhex-temporary-file-directory)))
+ temporary-file-directory)))
(save-excursion
(goto-char start)
(when (re-search-forward binhex-begin-line nil t)
@@ -296,7 +288,7 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(generate-new-buffer " *binhex-work*")))
(buffer-disable-undo work-buffer)
(insert-buffer-substring cbuf firstline end)
- (cd binhex-temporary-file-directory)
+ (cd temporary-file-directory)
(apply 'call-process-region
(point-min)
(point-max)
@@ -325,6 +317,8 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(binhex-decode-region-external start end)
(binhex-decode-region-internal start end)))
+(define-obsolete-function-alias 'binhex-char-int #'identity "28.1")
+
(provide 'binhex)
;;; binhex.el ends here
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 7f3dc4454ab..d524b26f1b9 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -208,7 +208,11 @@ This requires either the macOS \"open\" command, or the freedesktop
;;;###autoload
(defun report-emacs-bug (topic &optional unused)
"Report a bug in GNU Emacs.
-Prompts for bug subject. Leaves you in a mail buffer."
+Prompts for bug subject. Leaves you in a mail buffer.
+
+Already submitted bugs can be found in the Emacs bug tracker:
+
+ https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1"
(declare (advertised-calling-convention (topic) "24.5"))
(interactive "sBug Subject: ")
;; The syntax `version;' is preferred to `[version]' because the
@@ -270,7 +274,7 @@ Prompts for bug subject. Leaves you in a mail buffer."
'face 'link
'help-echo (concat "mouse-2, RET: Follow this link")
'action (lambda (button)
- (browse-url "https://debbugs.gnu.org/"))
+ (browse-url "https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1"))
'follow-link t)
(insert ". Please check that
@@ -301,42 +305,7 @@ usually do not have translators for other languages.\n\n")))
(let ((txt (delete-and-extract-region (1+ user-point) (point))))
(insert (propertize "\n" 'display txt)))
- (insert "\nIn " (emacs-version))
- (if emacs-build-system
- (insert " built on " emacs-build-system))
- (insert "\n")
-
- (if (stringp emacs-repository-version)
- (insert "Repository revision: " emacs-repository-version "\n"))
- (if (stringp emacs-repository-branch)
- (insert "Repository branch: " emacs-repository-branch "\n"))
- (if (fboundp 'x-server-vendor)
- (condition-case nil
- ;; This is used not only for X11 but also W32 and others.
- (insert "Windowing system distributor '" (x-server-vendor)
- "', version "
- (mapconcat 'number-to-string (x-server-version) ".") "\n")
- (error t)))
- (let ((os (ignore-errors (report-emacs-bug--os-description))))
- (if (stringp os)
- (insert "System Description: " os "\n\n")))
- (let ((message-buf (get-buffer "*Messages*")))
- (if message-buf
- (let (beg-pos
- (end-pos message-end-point))
- (with-current-buffer message-buf
- (goto-char end-pos)
- (forward-line -10)
- (setq beg-pos (point)))
- (terpri (current-buffer) t)
- (insert "Recent messages:\n")
- (insert-buffer-substring message-buf beg-pos end-pos))))
- (insert "\n")
- (when (and system-configuration-options
- (not (equal system-configuration-options "")))
- (insert "Configured using:\n 'configure "
- system-configuration-options "'\n\n")
- (fill-region (line-beginning-position -1) (point)))
+ (emacs-bug--system-description)
(insert "Configured features:\n" system-configuration-features "\n\n")
(fill-region (line-beginning-position -1) (point))
(insert "Important settings:\n")
@@ -417,72 +386,148 @@ usually do not have translators for other languages.\n\n")))
(buffer-substring-no-properties (point-min) (point)))
(goto-char user-point)))
+(defun emacs-bug--system-description ()
+ (insert "\nIn " (emacs-version))
+ (if emacs-build-system
+ (insert " built on " emacs-build-system))
+ (insert "\n")
+
+ (if (stringp emacs-repository-version)
+ (insert "Repository revision: " emacs-repository-version "\n"))
+ (if (stringp emacs-repository-branch)
+ (insert "Repository branch: " emacs-repository-branch "\n"))
+ (if (fboundp 'x-server-vendor)
+ (condition-case nil
+ ;; This is used not only for X11 but also W32 and others.
+ (insert "Windowing system distributor '" (x-server-vendor)
+ "', version "
+ (mapconcat 'number-to-string (x-server-version) ".") "\n")
+ (error t)))
+ (let ((os (ignore-errors (report-emacs-bug--os-description))))
+ (if (stringp os)
+ (insert "System Description: " os "\n\n")))
+ (when (and system-configuration-options
+ (not (equal system-configuration-options "")))
+ (insert "Configured using:\n 'configure "
+ system-configuration-options "'\n\n")
+ (fill-region (line-beginning-position -1) (point))))
+
(define-obsolete-function-alias 'report-emacs-bug-info 'info-emacs-bug "24.3")
(defun report-emacs-bug-hook ()
"Do some checking before sending a bug report."
- (save-excursion
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (and (= (- (point) (point-min))
- (length report-emacs-bug-orig-text))
- (string-equal (buffer-substring-no-properties (point-min) (point))
- report-emacs-bug-orig-text)
- (error "No text entered in bug report"))
- ;; Warning for novice users.
- (when (and (string-match "bug-gnu-emacs@gnu\\.org" (mail-fetch-field "to"))
- (not report-emacs-bug-no-confirmation)
- (not (yes-or-no-p
- "Send this bug report to the Emacs maintainers? ")))
- (with-output-to-temp-buffer "*Bug Help*"
- (princ (substitute-command-keys
- (format "\
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (and (= (- (point) (point-min))
+ (length report-emacs-bug-orig-text))
+ (string-equal (buffer-substring-no-properties (point-min) (point))
+ report-emacs-bug-orig-text)
+ (error "No text entered in bug report"))
+ ;; Warning for novice users.
+ (when (and (string-match "bug-gnu-emacs@gnu\\.org" (mail-fetch-field "to"))
+ (not report-emacs-bug-no-confirmation)
+ (not (yes-or-no-p
+ "Send this bug report to the Emacs maintainers? ")))
+ (with-output-to-temp-buffer "*Bug Help*"
+ (princ (substitute-command-keys
+ (format "\
You invoked the command M-x report-emacs-bug,
but you decided not to mail the bug report to the Emacs maintainers.
If you want to mail it to someone else instead,
please insert the proper e-mail address after \"To: \",
and send the mail again%s."
- (if report-emacs-bug-send-command
- (format " using \\[%s]"
- report-emacs-bug-send-command)
- "")))))
- (error "M-x report-emacs-bug was canceled, please read *Bug Help* buffer"))
- ;; Query the user for the SMTP method, so that we can skip
- ;; questions about From header validity if the user is going to
- ;; use mailclient, anyway.
- (when (or (and (derived-mode-p 'message-mode)
- (eq message-send-mail-function 'sendmail-query-once))
- (and (not (derived-mode-p 'message-mode))
- (eq send-mail-function 'sendmail-query-once)))
- (sendmail-query-user-about-smtp)
- (when (derived-mode-p 'message-mode)
- (setq message-send-mail-function (message-default-send-mail-function))))
- (or report-emacs-bug-no-confirmation
- ;; mailclient.el does not need a valid From
- (if (derived-mode-p 'message-mode)
- (eq message-send-mail-function 'message-send-mail-with-mailclient)
- (eq send-mail-function 'mailclient-send-it))
- ;; Not narrowing to the headers, but that's OK.
- (let ((from (mail-fetch-field "From")))
- (and (or (not from)
- (message-bogus-recipient-p from)
- ;; This is the default user-mail-address. On today's
- ;; systems, it seems more likely to be wrong than right,
- ;; since most people don't run their own mail server.
- (string-match (format "\\<%s@%s\\>"
- (regexp-quote (user-login-name))
- (regexp-quote (system-name)))
- from))
- (not (yes-or-no-p
- (format-message "Is `%s' really your email address? "
- from)))
- (error "Please edit the From address and try again"))))
- ;; Bury the help buffer (if it's shown).
- (when-let ((help (get-buffer "*Bug Help*")))
- (when (get-buffer-window help)
- (quit-window nil (get-buffer-window help))))))
+ (if report-emacs-bug-send-command
+ (format " using \\[%s]"
+ report-emacs-bug-send-command)
+ "")))))
+ (error "M-x report-emacs-bug was canceled, please read *Bug Help* buffer"))
+ ;; Query the user for the SMTP method, so that we can skip
+ ;; questions about From header validity if the user is going to
+ ;; use mailclient, anyway.
+ (when (or (and (derived-mode-p 'message-mode)
+ (eq (message-default-send-mail-function) 'sendmail-query-once))
+ (and (not (derived-mode-p 'message-mode))
+ (eq send-mail-function 'sendmail-query-once)))
+ (setq send-mail-function (sendmail-query-user-about-smtp))
+ (when (derived-mode-p 'message-mode)
+ (setq message-send-mail-function (message-default-send-mail-function))
+ (add-hook 'message-sent-hook
+ (lambda ()
+ (when (y-or-n-p "Save this mail sending choice?")
+ (customize-save-variable 'send-mail-function
+ send-mail-function)))
+ nil t)))
+ (or report-emacs-bug-no-confirmation
+ ;; mailclient.el does not need a valid From
+ (eq send-mail-function 'mailclient-send-it)
+ ;; Not narrowing to the headers, but that's OK.
+ (let ((from (mail-fetch-field "From")))
+ (when (and (or (not from)
+ (message-bogus-recipient-p from)
+ ;; This is the default user-mail-address. On
+ ;; today's systems, it seems more likely to
+ ;; be wrong than right, since most people
+ ;; don't run their own mail server.
+ (string-match (format "\\<%s@%s\\>"
+ (regexp-quote (user-login-name))
+ (regexp-quote (system-name)))
+ from))
+ (not (yes-or-no-p
+ (format-message "Is `%s' really your email address? "
+ from))))
+ (goto-char (point-min))
+ (re-search-forward "^From: " nil t)
+ (error "Please edit the From address and try again"))))
+ ;; Bury the help buffer (if it's shown).
+ (when-let ((help (get-buffer "*Bug Help*")))
+ (when (get-buffer-window help)
+ (quit-window nil (get-buffer-window help)))))
+;;;###autoload
+(defun submit-emacs-patch (subject file)
+ "Send an Emacs patch to the Emacs maintainers.
+Interactively, you will be prompted for SUBJECT and a patch FILE
+name (which will be attached to the mail). You will end up in a
+Message buffer where you can explain more about the patch."
+ (interactive "sThis patch is about: \nfPatch file name: ")
+ (switch-to-buffer "*Patch Help*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert "Thank you for considering submitting a patch to the Emacs project.\n\n"
+ "Please describe what the patch fixes (or, if it's a new feature, what it\n"
+ "implements) in the mail buffer below. When done, use the `C-c C-c' command\n"
+ "to send the patch as an email to the Emacs issue tracker.\n\n"
+ "If this is the first time you've submitted an Emacs patch, please\n"
+ "read the ")
+ (insert-text-button
+ "CONTRIBUTE"
+ 'action (lambda (_)
+ (view-buffer
+ (find-file-noselect
+ (expand-file-name "CONTRIBUTE" installation-directory)))))
+ (insert " file first.\n")
+ (goto-char (point-min))
+ (view-mode 1)
+ (button-mode 1))
+ (message-mail-other-window report-emacs-bug-address subject)
+ (insert "\n\n\n")
+ (emacs-bug--system-description)
+ (mml-attach-file file "text/patch" nil "attachment")
+ (message-goto-body)
+ (message "Write a description of the patch and use `C-c C-c' to send it")
+ (add-hook 'message-send-hook
+ (lambda ()
+ (message-goto-body)
+ (insert "Tags: patch\n\n"))
+ nil t)
+ (message-add-action
+ (lambda ()
+ ;; Bury the help buffer (if it's shown).
+ (when-let ((help (get-buffer "*Patch Help*")))
+ (when (get-buffer-window help)
+ (quit-window nil (get-buffer-window help)))))
+ 'send))
(provide 'emacsbug)
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index b9920023d82..6effe139864 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -1203,7 +1203,7 @@ no longer matches to transformed string. Used by function
feedmail-tidy-up-slug and indirectly by feedmail-queue-subject-slug-maker."
:version "24.1"
:group 'feedmail-queue
- :type 'string
+ :type 'regexp
)
@@ -1630,7 +1630,7 @@ local gurus."
(let ((result (smtpmail-via-smtp addr-listoid prepped)))
(when result
(set-buffer errors-to)
- (insert "Send via smtpmail failed: %s" result)
+ (insert "Send via smtpmail failed: " result)
(let ((case-fold-search t)
;; don't be overconfident about the name of the trace buffer
(tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server))))
@@ -1911,7 +1911,7 @@ see the variable feedmail-prompt-before-queue-user-alist.
(and (stringp feedmail-prompt-before-queue-help-supplement)
(princ feedmail-prompt-before-queue-help-supplement))
(with-current-buffer standard-output
- (if (fboundp 'help-mode) (help-mode)))))
+ (help-mode))))
(defun feedmail-message-action-scroll-up ()
@@ -1972,13 +1972,9 @@ backup file names and the like)."
(list-of-possible-fqms))
(if (and (> q-cnt 0) feedmail-queue-runner-confirm-global)
(setq do-the-run
- (if (fboundp 'y-or-n-p-with-timeout)
- (y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
- d-cnt d-oth q-cnt q-oth)
- 5 nil)
- (y-or-n-p (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
- d-cnt d-oth q-cnt q-oth))
- )))
+ (y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
+ d-cnt d-oth q-cnt q-oth)
+ 5 nil)))
(if (not do-the-run)
(setq messages-skipped q-cnt)
(save-window-excursion
@@ -1997,15 +1993,10 @@ backup file names and the like)."
(if (and already-buffer (buffer-modified-p already-buffer))
(save-window-excursion
(display-buffer (set-buffer already-buffer))
- (if (fboundp 'y-or-n-p-with-timeout)
- ;; make a guess that the user just forgot to save
- (if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t)
- (save-buffer))
- (if (y-or-n-p (format "FQM: Visiting %s; save before send? " blobby))
- (save-buffer))
- )))
-
- (set-buffer blobby-buffer)
+ ;; make a guess that the user just forgot to save
+ (if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t)
+ (save-buffer))))
+ (set-buffer blobby-buffer)
(setq buffer-offer-save nil)
(buffer-disable-undo blobby-buffer)
(insert-file-contents-literally maybe-file)
@@ -2158,17 +2149,8 @@ you can set `feedmail-queue-reminder-alist' to nil."
(setq answer (cons '^ helper))
(if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y))
(setq user-sez d-char))
- ;; these char-to-int things are because of some
- ;; incomprehensible difference between the two in
- ;; byte-compiled stuff between Emacs and XEmacs
- ;; (well, I'm sure someone could comprehend it,
- ;; but I say 'uncle')
- (setq answer (or (assoc user-sez user-alist)
- (and (fboundp 'char-to-int)
- (assoc (char-to-int user-sez) user-alist))
- (assoc user-sez standard-alist)
- (and (fboundp 'char-to-int)
- (assoc (char-to-int user-sez) standard-alist))))
+ (setq answer (or (assoc user-sez user-alist)
+ (assoc user-sez standard-alist)))
(if (or (null answer) (null (cdr answer)))
(progn
(beep)
@@ -2414,7 +2396,7 @@ mapped to mostly alphanumerics for safety."
;; mail-aliases nil = mail-abbrevs.el
(feedmail-say-debug "expanding mail aliases")
(if (or feedmail-force-expand-mail-aliases
- (and (fboundp 'expand-mail-aliases) mail-aliases))
+ mail-aliases)
(expand-mail-aliases (point-min) eoh-marker))
;; Make it pretty.
@@ -3130,8 +3112,7 @@ been weeded out."
;; won't delete the newly created frame upon exit!
(save-window-excursion
(switch-to-buffer buffer)
- (if (and (fboundp 'y-or-n-p-with-timeout)
- (numberp feedmail-confirm-outgoing-timeout))
+ (if (numberp feedmail-confirm-outgoing-timeout)
(y-or-n-p-with-timeout
"FQM: Send this email? "
(abs feedmail-confirm-outgoing-timeout)
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index af3b493a08a..b357b3e2563 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -131,31 +131,38 @@ lines."
(goto-char (match-end 0))
(unless (looking-at " ")
(insert " "))
- (end-of-line)
- (when (and (not (eobp))
- (save-excursion
- (forward-line 1)
- (looking-at (format "\\(%s ?\\)[^>]" prefix))))
- ;; Delete the newline and the quote at the start of the
- ;; next line.
- (delete-region (point) (match-end 1))
- (ignore-errors
+ (while (and (eq (char-before (line-end-position)) ?\s)
+ (not (eobp))
+ (save-excursion
+ (forward-line 1)
+ (looking-at (format "\\(%s ?\\)[^>]" prefix))))
+ (end-of-line)
+ (when (and (not (eobp))
+ (save-excursion
+ (forward-line 1)
+ (looking-at (format "\\(%s ?\\)[^>]" prefix))))
+ ;; Delete the newline and the quote at the start of the
+ ;; next line.
+ (delete-region (point) (match-end 1))))
+ (ignore-errors
(let ((fill-prefix (concat prefix " "))
adaptive-fill-mode)
(fill-region (line-beginning-position)
(line-end-position)
- 'left 'nosqueeze))))))
- (t
+ 'left 'nosqueeze)))))
+ (t
;; Delete the newline.
(when (eq (following-char) ?\s)
(delete-char 1))
;; Hack: Don't do the flowing on the signature line.
(when (and (not (looking-at "-- $"))
(eq (char-before (line-end-position)) ?\s))
- (end-of-line)
- (when delete-space
- (delete-char -1))
- (delete-char 1)
+ (while (and (not (eobp))
+ (eq (char-before (line-end-position)) ?\s))
+ (end-of-line)
+ (when delete-space
+ (delete-char -1))
+ (delete-char 1))
(ignore-errors
(let ((fill-prefix ""))
(fill-region (line-beginning-position)
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 61f7cbf9695..67bfbf703bb 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -5,7 +5,7 @@
;; Author: Steven L Baur <steve@xemacs.org> (1997-2011)
;; Boruch Baum <boruch_baum@gmx.com> (2017-)
;; Keywords: mail, news
-;; Version: 0.19
+;; Old-Version: 0.19
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index 12cffd9bc4b..a2705d659a4 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -116,15 +116,6 @@ For example, you may want to set this to (\"-Z2\") to reduce header length."
(require 'mail-utils)
-(eval-and-compile
- (if (fboundp 'point-at-bol)
- (defalias 'hashcash-point-at-bol 'point-at-bol)
- (defalias 'hashcash-point-at-bol 'line-beginning-position))
-
- (if (fboundp 'point-at-eol)
- (defalias 'hashcash-point-at-eol 'point-at-eol)
- (defalias 'hashcash-point-at-eol 'line-end-position)))
-
(defun hashcash-strip-quoted-names (addr)
(setq addr (mail-strip-quoted-names addr))
(if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr))
@@ -141,8 +132,8 @@ For example, you may want to set this to (\"-Z2\") to reduce header length."
(let ((token ""))
(cl-loop
(setq token
- (concat token (buffer-substring (point) (hashcash-point-at-eol))))
- (goto-char (hashcash-point-at-eol))
+ (concat token (buffer-substring (point) (line-end-position))))
+ (goto-char (line-end-position))
(forward-char 1)
(unless (looking-at "[ \t]") (cl-return token))
(while (looking-at "[ \t]") (forward-char 1))))))
@@ -374,6 +365,9 @@ Prefix arg sets default accept amount temporarily."
(message "Payment valid"))
ok))))
+(define-obsolete-function-alias 'hashcash-point-at-bol #'line-beginning-position "28.1")
+(define-obsolete-function-alias 'hashcash-point-at-eol #'line-end-position "28.1")
+
(provide 'hashcash)
;;; hashcash.el ends here
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index f1a455dce2d..49dfd2ee874 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1851,11 +1851,16 @@ place. It affects how `mail-extract-address-components' works."
;; Updated by the RIPE Network Coordination Centre.
;;
;; Source: ISO 3166 Maintenance Agency
-;; http://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt
-;; http://www.iana.org/domain-names.htm
-;; http://www.iana.org/cctld/cctld-whois.htm
+;; https://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt
+;; https://www.iana.org/domain-names.htm
+;; https://www.iana.org/cctld/cctld-whois.htm
;; Latest change: 2007/11/15
+;; FIXME: There are over 1500 top level domains, the vast majority of
+;; which are not in the below list. Should they be?
+;; https://data.iana.org/TLD/tlds-alpha-by-domain.txt
+;; https://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
+
(defconst mail-extr-all-top-level-domains
(let ((ob (make-vector 739 0)))
(mapc
@@ -2145,6 +2150,80 @@ place. It affects how `mail-extract-address-components' works."
("uucp" t "Unix to Unix CoPy")
;; Infrastructure Domains:
("arpa" t "Advanced Research Projects Agency (U.S. DoD)")
+ ;; Geographic Domains:
+ ("abudhabi" "Abu Dhabi")
+ ("africa" "Africa")
+ ("alsace" "Alsace, France")
+ ("amsterdam" "Amsterdam, The Netherlands")
+ ("arab" "League of Arab States")
+ ("asia" "Asia-Pacific region")
+ ("bar" "Bar, Montenegro")
+ ("barcelona" "Barcelona, Spain")
+ ("bayern" "Bavaria, Germany")
+ ("bcn" "Barcelona, Spain")
+ ("berlin" "Berlin, Germany")
+ ("boston" "Boston, Massachusetts")
+ ("brussels" "Brussels, Belgium")
+ ("budapest" "Budapest, Hungary")
+ ("bzh" "Brittany, France")
+ ("capetown" "Cape Town, South Africa")
+ ("cat" "Catalonia, Spain")
+ ("cologne" "Cologne, Germany")
+ ("corsica" "Corsica, France")
+ ("cymru" "Wales, United Kingdom")
+ ("doha" "Doha")
+ ("dubai" "Dubai")
+ ("durban" "Durban, South Africa")
+ ("eus" "Basque, Spain and France")
+ ("frl" "Friesland, Netherlands")
+ ("gal" "Galicia, Spain")
+ ("gent" "Ghent, Belgium")
+ ("hamburg" "Hamburg, Germany")
+ ("helsinki" "Helsinki, Finland")
+ ("irish" "Ireland")
+ ("ist" "İstanbul, Turkey")
+ ("istanbul" "İstanbul, Turkey")
+ ("joburg" "Johannesburg, South Africa")
+ ("kiwi" "New Zealanders")
+ ("koeln" "Cologne, Germany")
+ ("krd" "Kurdistan")
+ ("kyoto" "Kyoto, Japan")
+ ("lat" "Latin America")
+ ("london" "London, United Kingdom")
+ ("madrid" "Madrid, Spain")
+ ("melbourne" "Melbourne, Australia")
+ ("miami" "Miami, Florida")
+ ("nagoya" "Nagoya, Japan")
+ ("nrw" "North Rhine-Westphalia, Germany")
+ ("nyc" "New York City, New York")
+ ("okinawa" "Okinawa, Japan")
+ ("osaka" "Osaka, Japan")
+ ("paris" "Paris, France")
+ ("quebec" "Québec, Canada")
+ ("rio" "Rio de Janeiro, Brazil")
+ ("ruhr" "Ruhr, Germany")
+ ("ryukyu" "Ryukyu Islands, Japan")
+ ("saarland" "Saarland, Germany")
+ ("scot" "Scotland, United Kingdom")
+ ("stockholm" "Stockholm, Sweden")
+ ("swiss" "Switzerland")
+ ("sydney" "Sydney, Australia")
+ ("taipei" "Taipei, Taiwan")
+ ("tatar" "Tatars")
+ ("tirol" "Tyrol, Austria")
+ ("tokyo" "Tokyo, Japan")
+ ("vegas" "Las Vegas, Nevada")
+ ("wales" "Wales, United Kingdom")
+ ("wien" "Vienna, Austria")
+ ("yokohama" "Yokohama, Japan")
+ ("zuerich" "Zurich, Switzerland")
+ ;; Internationalized Geographic Domains:
+ ("xn--1qqw23a" "Foshan, China")
+ ("xn--xhq521b" "Guangdong, China")
+ ("xn--80adxhks" "Moscow, Russia")
+ ("xn--p1acf" "Russia")
+ ("xn--mgbca7dzdo" "Abu Dhabi")
+ ("xn--ngbrx" "Arab")
))
ob))
diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el
index 894313633da..e0274c8a11b 100644
--- a/lisp/mail/mail-parse.el
+++ b/lisp/mail/mail-parse.el
@@ -1,4 +1,4 @@
-;;; mail-parse.el --- Interface functions for parsing mail
+;;; mail-parse.el --- Interface functions for parsing mail -*- lexical-binding: t -*-
;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
diff --git a/lisp/mail/mail-prsvr.el b/lisp/mail/mail-prsvr.el
index 9023c00a66e..7c67c49b0b4 100644
--- a/lisp/mail/mail-prsvr.el
+++ b/lisp/mail/mail-prsvr.el
@@ -1,4 +1,4 @@
-;;; mail-prsvr.el --- Interface variables for parsing mail
+;;; mail-prsvr.el --- Interface variables for parsing mail -*- lexical-binding: t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index a6a606828f9..de4fe257f02 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -377,11 +377,11 @@ double-quotes."
(setq result (cons (substring definition start end) result)
start (and end (match-end 0)))))
(setq definition
- (mapconcat (function (lambda (x)
+ (mapconcat (lambda (x)
(or (mail-resolve-all-aliases-1
- (intern-soft (downcase x) mail-abbrevs)
- (cons sym so-far))
- x)))
+ (intern-soft (downcase x) mail-abbrevs)
+ (cons sym so-far))
+ x))
(nreverse result)
mail-alias-separator-string))
(set sym definition))))
@@ -436,12 +436,12 @@ of a mail alias. The value is set up, buffer-local, when first needed.")
(_ (aref (standard-syntax-table) ?_))
(w (aref (standard-syntax-table) ?w)))
(map-char-table
- (function (lambda (key value)
- (if (null value)
- ;; Fetch the inherited value
- (setq value (aref tab key)))
- (if (equal value _)
- (set-char-table-range tab key w))))
+ (lambda (key value)
+ (if (null value)
+ ;; Fetch the inherited value
+ (setq value (aref tab key)))
+ (if (equal value _)
+ (set-char-table-range tab key w)))
tab)
(modify-syntax-entry ?@ "w" tab)
(modify-syntax-entry ?% "w" tab)
@@ -534,8 +534,7 @@ of a mail alias. The value is set up, buffer-local, when first needed.")
(default-directory (expand-file-name "~/"))
(def mail-personal-alias-file))
(read-file-name
- (format "Read additional aliases from file (default %s): "
- def)
+ (format-prompt "Read additional aliases from file" def)
default-directory
(expand-file-name def default-directory)
t))))
@@ -548,7 +547,7 @@ of a mail alias. The value is set up, buffer-local, when first needed.")
(default-directory (expand-file-name "~/"))
(def mail-personal-alias-file))
(read-file-name
- (format "Read mail aliases from file (default %s): " def)
+ (format-prompt "Read mail aliases from file" def)
default-directory
(expand-file-name def default-directory)
t))))
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index 8e7aaf94937..2b76539e152 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -255,9 +255,9 @@ removed from alias expansions."
By default, this is the file specified by `mail-personal-alias-file'."
(interactive
(list
- (read-file-name (format "Read mail alias file (default %s): "
- mail-personal-alias-file)
- nil mail-personal-alias-file t)))
+ (read-file-name
+ (format-prompt "Read mail alias file" mail-personal-alias-file)
+ nil mail-personal-alias-file t)))
(setq file (expand-file-name (or file mail-personal-alias-file)))
;; In case mail-aliases is t, make sure define-mail-alias
;; does not recursively call build-mail-aliases.
@@ -517,7 +517,7 @@ PREFIX is the string we want to complete."
(setq mail-names
(sort (append (if (consp mail-aliases)
(mapcar
- (function (lambda (a) (list (car a))))
+ (lambda (a) (list (car a)))
mail-aliases))
(if (consp mail-local-names)
mail-local-names)
diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el
index 08325484677..405ae17a12c 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -134,7 +134,7 @@ The mail client is taken to be the handler of mailto URLs."
character-coding
;; Use the external browser function to send the
;; message.
- (browse-url-mailto-function nil))
+ (browse-url-default-handlers nil))
;; initialize limiter
(setq mailclient-delim-static "?")
;; construct and call up mailto URL
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 94b0886c75f..ab2649feb4b 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -1,4 +1,4 @@
-;;; mspools.el --- show mail spools waiting to be read
+;;; mspools.el --- show mail spools waiting to be read -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
@@ -125,18 +125,15 @@
(defcustom mspools-update nil
"Non-nil means update *spools* buffer after visiting any folder."
- :type 'boolean
- :group 'mspools)
+ :type 'boolean)
(defcustom mspools-suffix "spool"
"Extension used for spool files (not including full stop)."
- :type 'string
- :group 'mspools)
+ :type 'string)
(defcustom mspools-using-vm (fboundp 'vm)
"Non-nil if VM is used as mail reader, otherwise RMAIL is used."
- :type 'boolean
- :group 'mspools)
+ :type 'boolean)
(defcustom mspools-folder-directory
(if (boundp 'vm-folder-directory)
@@ -144,8 +141,7 @@
"~/MAIL/")
"Directory where mail folders are kept. Ensure it has a trailing /.
Defaults to `vm-folder-directory' if bound else to ~/MAIL/."
- :type 'directory
- :group 'mspools)
+ :type 'directory)
(defcustom mspools-vm-system-mail (or (getenv "MAIL")
(concat rmail-spool-directory
@@ -156,8 +152,7 @@ without it. By default this will be set to the environment variable
$MAIL. Otherwise it will use `rmail-spool-directory' to guess where
your primary spool is. If this fails, set it to something like
/usr/spool/mail/login-name."
- :type 'file
- :group 'mspools)
+ :type 'file)
;;; Internal Variables
@@ -175,11 +170,8 @@ your primary spool is. If this fails, set it to something like
(define-key map "\C-c\C-c" 'mspools-visit-spool)
(define-key map "\C-m" 'mspools-visit-spool)
(define-key map " " 'mspools-visit-spool)
- (define-key map "?" 'mspools-help)
- (define-key map "q" 'mspools-quit)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
- (define-key map "g" 'revert-buffer)
map)
"Keymap for the *spools* buffer.")
@@ -221,14 +213,15 @@ your primary spool is. If this fails, set it to something like
(concat mspools-folder-directory s "." mspools-suffix)
(concat mspools-folder-directory s ".crash")))
;; So I create a vm-spool-files entry for each of those mail drops
- (mapcar 'file-name-sans-extension
+ (mapcar #'file-name-sans-extension
(directory-files mspools-folder-directory nil
(format "\\`[^.]+\\.%s" mspools-suffix)))
))
))
;;; MSPOOLS-SHOW -- the main function
-(defun mspools-show ( &optional noshow)
+;;;###autoload
+(defun mspools-show (&optional noshow)
"Show the list of non-empty spool files in the *spools* buffer.
Buffer is not displayed if SHOW is non-nil."
(interactive)
@@ -237,7 +230,7 @@ Buffer is not displayed if SHOW is non-nil."
(progn
(set-buffer mspools-buffer)
(setq buffer-read-only nil)
- (delete-region (point-min) (point-max)))
+ (erase-buffer))
;; else buffer doesn't exist so create it
(get-buffer-create mspools-buffer))
@@ -260,8 +253,8 @@ Buffer is not displayed if SHOW is non-nil."
(defun mspools-visit-spool ()
"Visit the folder on the current line of the *spools* buffer."
(interactive)
- (let ( spool-name folder-name)
- (setq spool-name (mspools-get-spool-name))
+ (let ((spool-name (mspools-get-spool-name))
+ folder-name)
(if (null spool-name)
(message "No spool on current line")
@@ -270,19 +263,20 @@ Buffer is not displayed if SHOW is non-nil."
;; put in a little "*" to indicate spool file has been read.
(if (not mspools-update)
(save-excursion
- (setq buffer-read-only nil)
(beginning-of-line)
- (insert "*")
- (delete-char 1)
- (setq buffer-read-only t)
- ))
+ (let ((inhibit-read-only t))
+ (insert "*")
+ (delete-char 1))))
(message "folder %s spool %s" folder-name spool-name)
- (if (eq (count-lines (point-min) (point-at-eol))
- mspools-files-len)
- (forward-line (- 1 mspools-files-len)) ;back to top of list
- ;; else just on to next line
- (forward-line 1))
+ (forward-line (if (eq (count-lines (point-min) (point-at-eol))
+ mspools-files-len)
+ ;; FIXME: Why use `mspools-files-len' instead
+ ;; of looking if we're on the last line and
+ ;; jumping to the first one if so?
+ (- 1 mspools-files-len) ;back to top of list
+ ;; else just on to next line
+ 1))
;; Choose whether to use VM or RMAIL for reading folder.
(if mspools-using-vm
@@ -296,8 +290,8 @@ Buffer is not displayed if SHOW is non-nil."
(if mspools-update
;; generate new list of spools.
- (save-excursion
- (mspools-show-again 'noshow))))))
+ (save-excursion ;;FIXME: Why?
+ (mspools-revert-buffer))))))
(defun mspools-get-folder-from-spool (name)
"Return folder name corresponding to the spool file NAME."
@@ -319,27 +313,31 @@ Buffer is not displayed if SHOW is non-nil."
(defun mspools-get-spool-name ()
"Return the name of the spool on the current line."
(let ((line-num (1- (count-lines (point-min) (point-at-eol)))))
+ ;; FIXME: Why not extract the name directly from the current line's text?
(car (nth line-num mspools-files))))
;;; Spools mode functions
-(defun mspools-revert-buffer (ignore noconfirm)
- "Re-run mspools-show to revert the *spools* buffer."
+(defun mspools-revert-buffer (&optional _ignore _noconfirm)
+ "Re-run `mspools-show' to revert the *spools* buffer."
(mspools-show 'noshow))
(defun mspools-show-again (&optional noshow)
- "Update the *spools* buffer. This is useful if mspools-update is
-nil."
+ "Update the *spools* buffer.
+This is useful if `mspools-update' is nil."
+ (declare (obsolete revert-buffer "28.1"))
(interactive)
(mspools-show noshow))
(defun mspools-help ()
"Show help for `mspools-mode'."
+ (declare (obsolete describe-mode "28.1"))
(interactive)
(describe-function 'mspools-mode))
(defun mspools-quit ()
"Quit the *spools* buffer."
+ (declare (obsolete quit-window "28.1"))
(interactive)
(kill-buffer mspools-buffer))
@@ -353,32 +351,26 @@ nil."
(defun mspools-get-spool-files ()
"Find the list of spool files and display them in *spools* buffer."
- (let (folders head spool len beg end any)
- (if (null mspools-folder-directory)
- (error "Set `mspools-folder-directory' to where the spool files are"))
- (setq folders (directory-files mspools-folder-directory nil
+ (if (null mspools-folder-directory)
+ (error "Set `mspools-folder-directory' to where the spool files are"))
+ (let* ((folders (directory-files mspools-folder-directory nil
(format "\\`[^.]+\\.%s\\'" mspools-suffix)))
- (setq folders (mapcar 'mspools-size-folder folders))
- (setq folders (delq nil folders))
+ (folders (delq nil (mapcar #'mspools-size-folder folders)))
+ ;; beg end
+ )
(setq mspools-files folders)
(setq mspools-files-len (length mspools-files))
- (set-buffer mspools-buffer)
- (while folders
- (setq any t)
- (setq head (car folders))
- (setq spool (car head))
- (setq len (cdr head))
- (setq folders (cdr folders))
- (setq beg (point))
- (insert (format " %10d %s" len spool))
- (setq end (point))
- (insert "\n")
- ;;(put-text-property beg end 'mouse-face 'highlight)
- )
- (if any
- (delete-char -1)) ;delete last RET
- (goto-char (point-min))
- ))
+ (with-current-buffer mspools-buffer
+ (pcase-dolist (`(,spool . ,len) folders)
+ ;; (setq beg (point))
+ (insert (format " %10d %s" len spool))
+ ;; (setq end (point))
+ (insert "\n")
+ ;;(put-text-property beg end 'mouse-face 'highlight)
+ )
+ (if (not (bolp))
+ (delete-char -1)) ;delete last RET
+ (goto-char (point-min)))))
(defun mspools-size-folder (spool)
"Return (SPOOL . SIZE ), if SIZE of spool file is non-zero."
diff --git a/lisp/mail/qp.el b/lisp/mail/qp.el
index 388c3981c97..10ac696fecf 100644
--- a/lisp/mail/qp.el
+++ b/lisp/mail/qp.el
@@ -1,4 +1,4 @@
-;;; qp.el --- Quoted-Printable functions
+;;; qp.el --- Quoted-Printable functions -*- lexical-binding:t -*-
;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
@@ -125,7 +125,7 @@ encode lines starting with \"From\"."
(not (eobp)))
(insert
(prog1
- (format "=%02X" (char-after))
+ (format "=%02X" (get-byte))
(delete-char 1))))
;; Encode white space at the end of lines.
(goto-char (point-min))
@@ -134,7 +134,7 @@ encode lines starting with \"From\"."
(while (not (eolp))
(insert
(prog1
- (format "=%02X" (char-after))
+ (format "=%02X" (get-byte))
(delete-char 1)))))
(let ((ultra
(and (boundp 'mm-use-ultra-safe-encoding)
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index edfceb373f7..0c8b8d47a08 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -51,7 +51,6 @@
;;(defun mypkg-submit-bug-report ()
;; "Submit via mail a bug report on mypkg"
;; (interactive)
-;; (require 'reporter)
;; (reporter-submit-bug-report
;; mypkg-maintainer-address
;; (concat "mypkg.el " mypkg-version)
diff --git a/lisp/mail/rfc2045.el b/lisp/mail/rfc2045.el
index 7d962ea2348..dba9c04cc83 100644
--- a/lisp/mail/rfc2045.el
+++ b/lisp/mail/rfc2045.el
@@ -1,4 +1,4 @@
-;;; rfc2045.el --- Functions for decoding rfc2045 headers
+;;; rfc2045.el --- Functions for decoding rfc2045 headers -*- lexical-binding:t -*-
;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index 234f319669f..4aa0c2809b2 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -716,11 +716,13 @@ Point moves to the end of the region."
(goto-char e)))))
(defun rfc2047-fold-field ()
- "Fold the current header field."
+ "Fold the current header field.
+Return the new end point."
(save-excursion
(save-restriction
(rfc2047-narrow-to-field)
- (rfc2047-fold-region (point-min) (point-max)))))
+ (rfc2047-fold-region (point-min) (point-max))
+ (point-max))))
(defun rfc2047-fold-region (b e)
"Fold long lines in region B to E."
diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el
index add099745b6..17da60e0bee 100644
--- a/lisp/mail/rfc2231.el
+++ b/lisp/mail/rfc2231.el
@@ -215,23 +215,25 @@ These look like:
\"\\='en-us\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\",
\"\\='\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\", or
\"This is ***fun***\"."
- (string-match "\\`\\(?:\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string)
- (let ((coding-system (mm-charset-to-coding-system
- (match-string 1 string) nil t))
- ;;(language (match-string 2 string))
- (value (match-string 3 string)))
- (mm-with-unibyte-buffer
- (insert value)
- (goto-char (point-min))
- (while (re-search-forward "%\\([[:xdigit:]][[:xdigit:]]\\)" nil t)
- (insert
- (prog1
- (string-to-number (match-string 1) 16)
- (delete-region (match-beginning 0) (match-end 0)))))
- ;; Decode using the charset, if any.
- (if (memq coding-system '(nil ascii))
- (buffer-string)
- (decode-coding-string (buffer-string) coding-system)))))
+ (if (not (string-match "\\`\\(?:\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)\\'"
+ string))
+ (error "Unrecognized RFC2231 format: %S" string)
+ (let ((value (match-string 3 string))
+ ;;(language (match-string 2 string))
+ (coding-system (mm-charset-to-coding-system
+ (match-string 1 string) nil t)))
+ (mm-with-unibyte-buffer
+ (insert value)
+ (goto-char (point-min))
+ (while (re-search-forward "%\\([[:xdigit:]][[:xdigit:]]\\)" nil t)
+ (insert
+ (prog1
+ (string-to-number (match-string 1) 16)
+ (delete-region (match-beginning 0) (match-end 0)))))
+ ;; Decode using the charset, if any.
+ (if (memq coding-system '(nil ascii))
+ (buffer-string)
+ (decode-coding-string (buffer-string) coding-system))))))
(defun rfc2231-encode-string (param value)
"Return a PARAM=VALUE string encoded according to RFC2231.
diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el
index 7b38288be20..afa30590059 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/mail/rfc2368.el
@@ -1,4 +1,4 @@
-;;; rfc2368.el --- support for rfc2368
+;;; rfc2368.el --- support for rfc2368 -*- lexical-binding:t -*-
;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el
index f2fe1cd8166..4572f27faf8 100644
--- a/lisp/mail/rfc822.el
+++ b/lisp/mail/rfc822.el
@@ -226,11 +226,11 @@
((and (not (eobp)) (= (following-char) ?\@))
;; <@foo.bar,@baz:quux@abcd.efg>
(rfc822-snarf-frob-list "<...> address" ?\, ?\:
- (function (lambda ()
- (if (rfc822-looking-at ?\@)
- (rfc822-snarf-domain)
- (rfc822-bad-address
- "Gubbish in route-addr")))))
+ (lambda ()
+ (if (rfc822-looking-at ?\@)
+ (rfc822-snarf-domain)
+ (rfc822-bad-address
+ "Gubbish in route-addr"))))
(rfc822-snarf-words)
(or (rfc822-looking-at ?@)
(rfc822-bad-address "Malformed <..@..> address"))
diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el
index 1755f4eb467..db518482591 100644
--- a/lisp/mail/rmail-spam-filter.el
+++ b/lisp/mail/rmail-spam-filter.el
@@ -133,7 +133,7 @@ If any element matches the \"From\" header, the message is
flagged as a valid, non-spam message. E.g., if your domain is
\"emacs.com\" then including \"emacs\\\\.com\" in this list would
flag all mail (purporting to be) from your colleagues as valid."
- :type '(repeat string)
+ :type '(repeat regexp)
:group 'rmail-spam-filter)
(defcustom rsf-definitions-alist nil
@@ -157,22 +157,22 @@ A rule matches only if all the specified elements match."
(list :format "%v"
(cons :format "%v" :value (from . "")
(const :format "" from)
- (string :tag "From" ""))
+ (regexp :tag "From" ""))
(cons :format "%v" :value (to . "")
(const :format "" to)
- (string :tag "To" ""))
+ (regexp :tag "To" ""))
(cons :format "%v" :value (subject . "")
(const :format "" subject)
- (string :tag "Subject" ""))
+ (regexp :tag "Subject" ""))
(cons :format "%v" :value (content-type . "")
(const :format "" content-type)
- (string :tag "Content-Type" ""))
+ (regexp :tag "Content-Type" ""))
(cons :format "%v" :value (contents . "")
(const :format "" contents)
- (string :tag "Contents" ""))
+ (regexp :tag "Contents" ""))
(cons :format "%v" :value (x-spam-status . "")
(const :format "" x-spam-status)
- (string :tag "X-Spam-Status" ""))
+ (regexp :tag "X-Spam-Status" ""))
(cons :format "%v" :value (action . output-and-delete)
(const :format "" action)
(choice :tag "Action selection"
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 5a2391d6272..2c972ee7aac 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -39,6 +39,7 @@
(require 'mail-utils)
(require 'rfc2047)
+(require 'auth-source)
(require 'rmail-loaddefs)
@@ -417,20 +418,6 @@ The variable `rmail-highlighted-headers' specifies which headers."
:group 'rmail-headers
:version "22.1")
-;; This was removed in Emacs 23.1 with no notification, an unnecessary
-;; incompatible change.
-(defcustom rmail-highlight-face 'rmail-highlight
- "Face used by Rmail for highlighting headers."
- ;; Note that nil doesn't actually mean use the default face, it
- ;; means use either bold or highlight. It's not worth fixing this
- ;; now that this is obsolete.
- :type '(choice (const :tag "Default" nil)
- face)
- :group 'rmail-headers)
-(make-obsolete-variable 'rmail-highlight-face
- "customize the face `rmail-highlight' instead."
- "23.2")
-
(defface rmail-header-name
'((t (:inherit font-lock-function-name-face)))
"Face to use for highlighting the header names.
@@ -521,25 +508,6 @@ still the current message in the Rmail buffer.")
(defvar rmail-mmdf-delim2 "^\001\001\001\001\n"
"Regexp marking the end of an mmdf message.")
-;; FIXME Post-mbox, this is now unused.
-;; In Emacs-22, this was called:
-;; i) the very first time a message was shown.
-;; ii) when toggling the headers to the normal state, every time.
-;; It's not clear what it should do now, since there is nothing that
-;; records when a message is shown for the first time (unseen is not
-;; necessarily the same thing).
-;; See https://lists.gnu.org/r/emacs-devel/2009-03/msg00013.html
-(defcustom rmail-message-filter nil
- "If non-nil, a filter function for new messages in RMAIL.
-Called with region narrowed to the message, including headers,
-before obeying `rmail-ignored-headers'."
- :group 'rmail-headers
- :type '(choice (const nil) function))
-
-(make-obsolete-variable 'rmail-message-filter
- "it is not used (try `rmail-show-message-hook')."
- "23.1")
-
(defcustom rmail-automatic-folder-directives nil
"List of directives specifying how to automatically file messages.
Whenever Rmail shows a message in the folder that `rmail-file-name'
@@ -578,11 +546,21 @@ Examples:
(defvar rmail-reply-prefix "Re: "
"String to prepend to Subject line when replying to a message.")
+;; Note: this is matched with case-fold-search bound to t.
+(defcustom rmail-re-abbrevs
+ "\\(RE\\|رد\\|回å¤\\|回覆\\|SV\\|Antw\\|VS\\|REF\\|AW\\|ΑΠ\\|ΣΧΕΤ\\|השב\\|Vá\\|R\\|RIF\\|BLS\\|RES\\|Odp\\|YNT\\|ATB\\)"
+ "Regexp with localized 'Re:' abbreviations in various languages."
+ :version "28.1"
+ :type 'regexp)
+
;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:".
;; This pattern should catch all the common variants.
;; rms: I deleted the change to delete tags in square brackets
;; because they mess up RT tags.
-(defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*"
+(defvar rmail-reply-regexp
+ (concat "\\`\\("
+ rmail-re-abbrevs
+ "\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?[::] *\\)*")
"Regexp to delete from Subject line before inserting `rmail-reply-prefix'.")
(defcustom rmail-display-summary nil
@@ -1514,8 +1492,7 @@ If so restore the actual mbox message collection."
(setq require-final-newline nil)
(make-local-variable 'version-control)
(setq version-control 'never)
- (make-local-variable 'kill-buffer-hook)
- (add-hook 'kill-buffer-hook 'rmail-mode-kill-summary)
+ (add-hook 'kill-buffer-hook #'rmail-mode-kill-summary nil t)
(make-local-variable 'file-precious-flag)
(setq file-precious-flag t)
(make-local-variable 'desktop-save-buffer)
@@ -1907,7 +1884,8 @@ interactively."
(when rmail-remote-password-required
(setq got-password (not (rmail-have-password)))
(setq supplied-password (rmail-get-remote-password
- (string-match "^imaps?" proto))))
+ (string-match "^imaps?" proto)
+ user host)))
;; FIXME
;; The password is embedded. Strip it out since movemail
;; does not really like it, in spite of the movemail spec.
@@ -1927,14 +1905,12 @@ interactively."
((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file)
(let (got-password supplied-password
- ;; (proto "pop")
- ;; (user (match-string 1 file))
- ;; (host (match-string 3 file))
- )
+ (user (match-string 1 file))
+ (host (match-string 3 file)))
(when rmail-remote-password-required
(setq got-password (not (rmail-have-password)))
- (setq supplied-password (rmail-get-remote-password nil)))
+ (setq supplied-password (rmail-get-remote-password nil user host)))
(list file "pop" supplied-password got-password)))
@@ -2900,9 +2876,9 @@ The current mail message becomes the message displayed."
(rmail-display-labels)
(rmail-swap-buffers)
(setq rmail-buffer-swapped t)
- (run-hooks 'rmail-show-message-hook)
(when showing-message
- (setq blurb (format "Showing message %d...done" msg)))))
+ (setq blurb (format "Showing message %d...done" msg)))
+ (run-hooks 'rmail-show-message-hook)))
blurb))
(defun rmail-copy-headers (beg _end &optional ignored-headers)
@@ -3021,7 +2997,7 @@ using the coding system CODING."
(defun rmail-highlight-headers ()
"Highlight the headers specified by `rmail-highlighted-headers'.
-Uses the face specified by `rmail-highlight-face'."
+Uses the face `rmail-highlight'."
(if rmail-highlighted-headers
(save-excursion
(search-forward "\n\n" nil 'move)
@@ -3029,11 +3005,7 @@ Uses the face specified by `rmail-highlight-face'."
(narrow-to-region (point-min) (point))
(let ((case-fold-search t)
(inhibit-read-only t)
- ;; When rmail-highlight-face is removed, just
- ;; use 'rmail-highlight here.
- (face (or rmail-highlight-face
- (if (face-differs-from-default-p 'bold)
- 'bold 'highlight)))
+ (face 'rmail-highlight)
;; List of overlays to reuse.
(overlays rmail-overlay-list))
(goto-char (point-min))
@@ -3398,7 +3370,7 @@ whitespace, replacing whitespace runs with a single space and
removing prefixes such as Re:, Fwd: and so on and mailing list
tags such as [tag]."
(let ((subject (or (rmail-get-header "Subject" msgnum) ""))
- (regexp "\\`[ \t\n]*\\(\\(\\w\\{1,3\\}:\\|\\[[^]]+]\\)[ \t\n]+\\)*"))
+ (regexp "\\`[ \t\n]*\\(\\(\\w\\{1,4\\}[::]\\|\\[[^]]+]\\)[ \t\n]+\\)*"))
(setq subject (rfc2047-decode-string subject))
(setq subject (replace-regexp-in-string regexp "" subject))
(replace-regexp-in-string "[ \t\n]+" " " subject)))
@@ -4174,22 +4146,12 @@ The variable `rmail-retry-ignored-headers' is a regular expression
specifying headers which should not be copied into the new message."
(interactive)
(require 'mail-utils)
- ;; FIXME This does not handle rmail-mime-feature != 'rmailmm.
- ;; There is no API defined for rmail-mime-feature to provide
- ;; rmail-mime-message-p, rmail-mime-toggle-raw equivalents.
- ;; But does anyone actually use rmail-mime-feature != 'rmailmm?
- (if (and rmail-enable-mime
- (eq rmail-mime-feature 'rmailmm)
- (featurep rmail-mime-feature))
- (with-current-buffer rmail-buffer
- (if (rmail-mime-message-p)
- (let ((rmail-mime-mbox-buffer rmail-view-buffer)
- (rmail-mime-view-buffer rmail-buffer))
- (rmail-mime-toggle-raw 'raw)))))
-
- (let ((rmail-this-buffer (current-buffer))
+ (let (bounce-buffer ;; Buffer we found it in
+ bounce-start ;; Position of start of failed message in that buffer
+ bounce-end ;; Position of end of failed message in that buffer
+ bounce-indent ;; Number of columns we need to de-indent it.
(msgnum rmail-current-message)
- bounce-start bounce-end bounce-indent resending
+ resending
(content-type (rmail-get-header "Content-Type")))
(save-excursion
(goto-char (point-min))
@@ -4198,19 +4160,27 @@ specifying headers which should not be copied into the new message."
(string-match
";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?"
content-type))
- ;; Handle a MIME multipart bounce message.
+ ;; Handle a MIME multipart bounce message
+ ;; by scanning the raw buffer.
(let ((codestring
(concat "\n--"
(substring content-type (match-beginning 1)
- (match-end 1)))))
- (unless (re-search-forward mail-mime-unsent-header nil t)
- (error "Cannot find beginning of header in failed message"))
- (unless (search-forward "\n\n" nil t)
- (error "Cannot find start of Mime data in failed message"))
- (setq bounce-start (point))
- (if (search-forward codestring nil t)
- (setq bounce-end (match-beginning 0))
- (setq bounce-end (point-max))))
+ (match-end 1))))
+ (beg (rmail-msgbeg msgnum))
+ (end (rmail-msgend msgnum)))
+ (with-current-buffer rmail-view-buffer
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (unless (re-search-forward mail-mime-unsent-header nil t)
+ (error "Cannot find beginning of header in failed message"))
+ (unless (search-forward "\n\n" nil t)
+ (error "Cannot find start of Mime data in failed message"))
+ (setq bounce-start (point))
+ (setq bounce-buffer (current-buffer))
+ (if (search-forward codestring nil t)
+ (setq bounce-end (match-beginning 0))
+ (setq bounce-end (point-max))))))
;; Non-MIME bounce.
(or (re-search-forward mail-unsent-separator nil t)
(error "Cannot parse this as a failure message"))
@@ -4225,6 +4195,7 @@ specifying headers which should not be copied into the new message."
(setq bounce-indent (- (current-column)))
(goto-char (point-max))
(re-search-backward "^End of returned message$" nil t)
+ (setq bounce-buffer (current-buffer))
(setq bounce-end (point)))
;; One message contained a few random lines before
;; the old message header. The first line of the
@@ -4241,8 +4212,10 @@ specifying headers which should not be copied into the new message."
(setq bounce-start (point))
(goto-char (point-max))
(search-backward (concat "\n\n" boundary) bounce-start t)
+ (setq bounce-buffer (current-buffer))
(setq bounce-end (point)))
(setq bounce-start (point)
+ bounce-buffer (current-buffer)
bounce-end (point-max)))
(unless (search-forward "\n\n" nil t)
(error "Cannot find end of header in failed message"))))))
@@ -4251,9 +4224,9 @@ specifying headers which should not be copied into the new message."
;; Turn off the usual actions for initializing the message body
;; because we want to get only the text from the failure message.
(let (mail-signature mail-setup-hook)
- (if (rmail-start-mail nil nil nil nil nil rmail-this-buffer
+ (if (rmail-start-mail nil nil nil nil nil rmail-buffer
(list (list 'rmail-mark-message
- rmail-this-buffer
+ rmail-buffer
(aref rmail-msgref-vector msgnum)
rmail-retried-attr-index)))
;; Insert original text as initial text of new draft message.
@@ -4262,7 +4235,7 @@ specifying headers which should not be copied into the new message."
(let ((inhibit-read-only t)
eoh)
(erase-buffer)
- (insert-buffer-substring rmail-this-buffer
+ (insert-buffer-substring bounce-buffer
bounce-start bounce-end)
(goto-char (point-min))
(if bounce-indent
@@ -4393,9 +4366,8 @@ browsing, and moving of messages."
(text face mouse function &optional token prevline))
;; Make sure our special speedbar major mode is loaded
-(if (featurep 'speedbar)
- (rmail-install-speedbar-variables)
- (add-hook 'speedbar-load-hook 'rmail-install-speedbar-variables))
+(with-eval-after-load 'speedbar
+ (rmail-install-speedbar-variables))
(defun rmail-speedbar-buttons (buffer)
"Create buttons for BUFFER containing rmail messages.
@@ -4489,15 +4461,30 @@ TEXT and INDENT are not used."
(setq rmail-remote-password nil)
(setq rmail-encoded-remote-password nil)))
-(defun rmail-get-remote-password (imap)
- "Get the password for retrieving mail from a POP or IMAP server. If none
-has been set, then prompt the user for one."
+(defun rmail-get-remote-password (imap user host)
+ "Get the password for retrieving mail from a POP or IMAP server.
+If none has been set, the password is found via auth-source. If
+you use ~/.authinfo as your auth-source backend, then put
+something like the following in that file:
+
+machine mymachine login myloginname password mypassword
+
+If auth-source search yields no result, prompt the user for the
+password."
(when (not rmail-encoded-remote-password)
(if (not rmail-remote-password)
- (setq rmail-remote-password
- (read-passwd (if imap
- "IMAP password: "
- "POP password: "))))
+ (setq rmail-remote-password
+ (let ((found (nth 0 (auth-source-search
+ :max 1 :user user :host host
+ :require '(:secret)))))
+ (if found
+ (let ((secret (plist-get found :secret)))
+ (if (functionp secret)
+ (funcall secret)
+ secret))
+ (read-passwd (if imap
+ "IMAP password: "
+ "POP password: "))))))
(rmail-set-remote-password rmail-remote-password)
(setq rmail-remote-password nil))
(rmail-encode-string rmail-encoded-remote-password (emacs-pid)))
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index ba6ebad082c..3026283a082 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -63,9 +63,7 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(use-local-map rmail-edit-map)
(setq major-mode 'rmail-edit-mode)
(setq mode-name "RMAIL Edit")
- (if (boundp 'mode-line-modified)
- (setq mode-line-modified (default-value 'mode-line-modified))
- (setq mode-line-format (default-value 'mode-line-format)))
+ (setq mode-line-modified (default-value 'mode-line-modified))
;; Don't turn off auto-saving based on the size of the buffer
;; because that code does not understand buffer-swapping.
(make-local-variable 'auto-save-include-big-deletions)
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index cc55451902a..521659b7eb6 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -931,8 +931,8 @@ a negative argument means to delete and move backward."
(not (and backward (bobp))))
(rmail-summary-goto-msg)
(with-current-buffer rmail-buffer
- (rmail-delete-message)
- (setq del-msg rmail-current-message))
+ (setq del-msg rmail-current-message)
+ (rmail-delete-message))
(rmail-summary-mark-deleted del-msg)
(while (and (not (if backward (bobp) (eobp)))
(save-excursion (beginning-of-line)
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 65d598c3bac..7610939e575 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -529,7 +529,7 @@ This also saves the value of `send-mail-function' via Customize."
(display-buffer (current-buffer))
(let ((completion-ignore-case t))
(completing-read
- (format "Send mail via (default %s): " (caar options))
+ (format-prompt "Send mail via" (caar options))
options nil 'require-match nil nil (car options))))))
;; Return the choice.
(cdr (assoc-string choice options t))))
@@ -975,7 +975,7 @@ but lower priority than the local value of `buffer-file-coding-system'.
See also the function `select-message-coding-system'.")
;;;###autoload
-(defvar default-sendmail-coding-system 'iso-latin-1
+(defvar default-sendmail-coding-system 'utf-8
"Default coding system for encoding the outgoing mail.
This variable is used only when `sendmail-coding-system' is nil.
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index f5c9432879f..63c8f14085a 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -50,9 +50,10 @@
;; Modified by Simon Josefsson <jas@pdc.kth.se>, 22/2/99, to support SMTP
;; Authentication by the AUTH mechanism.
-;; See http://www.ietf.org/rfc/rfc2554.txt
+;; See https://www.ietf.org/rfc/rfc2554.txt
;;; Code:
+;;; Dependencies
(require 'sendmail)
(require 'auth-source)
@@ -61,12 +62,12 @@
(autoload 'message-make-message-id "message")
(autoload 'rfc2104-hash "rfc2104")
-;;;
+;;; Options
+
(defgroup smtpmail nil
"SMTP protocol for sending mail."
:group 'mail)
-
(defcustom smtpmail-default-smtp-server nil
"Specify default SMTP server.
This only has effect if you specify it before loading the smtpmail library."
@@ -172,8 +173,7 @@ mean \"try again\"."
:type 'integer
:version "27.1")
-;; End of customizable variables.
-
+;;; Variables
(defvar smtpmail-address-buffer)
(defvar smtpmail-recipient-address-list)
@@ -192,6 +192,8 @@ for `smtpmail-try-auth-method'.")
(defvar smtpmail-mail-address nil
"Value to use for envelope-from address for mail from ambient buffer.")
+;;; Functions
+
;;;###autoload
(defun smtpmail-send-it ()
(let ((errbuf (if mail-interactive
@@ -510,8 +512,9 @@ for `smtpmail-try-auth-method'.")
(if port
(format "%s" port)
"smtp"))
- (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
- (mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
+ (let* ((mechs (smtpmail-intersection
+ (cdr-safe (assoc 'auth supported-extensions))
+ smtpmail-auth-supported))
(auth-source-creation-prompts
'((user . "SMTP user name for %h: ")
(secret . "SMTP password for %u@%h: ")))
@@ -524,6 +527,7 @@ for `smtpmail-try-auth-method'.")
:require (and ask-for-password
'(:user :secret))
:create ask-for-password)))
+ (mech (or (plist-get auth-info :smtp-auth) (car mechs)))
(user (plist-get auth-info :user))
(password (plist-get auth-info :secret))
(save-function (and ask-for-password
diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el
index 8bcb3925a9b..0dce9b7b726 100644
--- a/lisp/mail/uudecode.el
+++ b/lisp/mail/uudecode.el
@@ -24,11 +24,6 @@
;;; Code:
-(defalias 'uudecode-char-int
- (if (fboundp 'char-int)
- 'char-int
- 'identity))
-
(defgroup uudecode nil
"Decoding of uuencoded data."
:group 'mail
@@ -61,10 +56,8 @@ input and write the converted data to its standard output."
(setq str (concat str "[^a-z]")))
(concat str ".?$")))
-(defvar uudecode-temporary-file-directory
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp")))
+(make-obsolete-variable 'uudecode-temporary-file-directory
+ 'temporary-file-directory "28.1")
;;;###autoload
(defun uudecode-decode-region-external (start end &optional file-name)
@@ -86,13 +79,7 @@ used is specified by `uudecode-decoder-program'."
(match-string 1)))))
(setq tempfile (if file-name
(expand-file-name file-name)
- (if (fboundp 'make-temp-file)
- (let ((temporary-file-directory
- uudecode-temporary-file-directory))
- (make-temp-file "uu"))
- (expand-file-name
- (make-temp-name "uu")
- uudecode-temporary-file-directory))))
+ (make-temp-file "uu")))
(let ((cdir default-directory)
(default-process-coding-system nil))
(unwind-protect
@@ -148,7 +135,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
((> (skip-chars-forward uudecode-alphabet end) 0)
(setq lim (point))
(setq remain
- (logand (- (uudecode-char-int (char-after inputpos)) 32)
+ (logand (- (char-after inputpos) 32)
63))
(setq inputpos (1+ inputpos))
(if (= remain 0) (setq done t))
@@ -156,7 +143,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
(setq bits (+ bits
(logand
(-
- (uudecode-char-int (char-after inputpos)) 32)
+ (char-after inputpos) 32)
63)))
(if (/= counter 0) (setq remain (1- remain)))
(setq counter (1+ counter)
@@ -207,6 +194,8 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
(uudecode-decode-region-external start end file-name)
(uudecode-decode-region-internal start end file-name)))
+(define-obsolete-function-alias 'uudecode-char-int #'identity "28.1")
+
(provide 'uudecode)
;;; uudecode.el ends here
diff --git a/lisp/man.el b/lisp/man.el
index bec3bfdbb2e..bd55d7eff06 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -253,7 +253,7 @@ the associated section number."
"Regexp that matches the text that precedes the command's name.
Used in `bookmark-set' to get the default bookmark name."
:version "24.1"
- :type 'string :group 'bookmark)
+ :type 'regexp :group 'bookmark)
(defcustom manual-program "man"
"Program used by `man' to produce man pages."
@@ -836,7 +836,8 @@ POS defaults to `point'."
;; ======================================================================
;; Top level command and background process sentinel
-;; For compatibility with older versions.
+;; This alias was originally for compatibility with older versions.
+;; Some users got used to having it, so we will not remove it.
;;;###autoload
(defalias 'manual-entry 'man)
@@ -926,15 +927,18 @@ foo(sec)[, bar(sec) [, ...]] [other stuff] - description"
;; run differently in Man-getpage-in-background, an error
;; here may not necessarily mean that we'll also get an
;; error later.
- (ignore-errors
- (call-process manual-program nil '(t nil) nil
- "-k" (concat (when (or Man-man-k-use-anchor
- (string-equal prefix ""))
- "^")
- prefix))))
- (setq table (Man-parse-man-k)))
+ (when (eq 0
+ (ignore-errors
+ (call-process
+ manual-program nil '(t nil) nil
+ "-k" (concat (when (or Man-man-k-use-anchor
+ (string-equal prefix ""))
+ "^")
+ prefix))))
+ (setq table (Man-parse-man-k)))))
;; Cache the table for later reuse.
- (setq Man-completion-cache (cons prefix table)))
+ (when table
+ (setq Man-completion-cache (cons prefix table))))
;; The table may contain false positives since the match is made
;; by "man -k" not just on the manpage's name.
(if section
@@ -1013,10 +1017,9 @@ to auto-complete your input based on the installed manual pages."
(completion-ignore-case t)
Man-completion-cache ;Don't cache across calls.
(input (completing-read
- (format "Manual entry%s"
- (if (string= default-entry "")
- ": "
- (format " (default %s): " default-entry)))
+ (format-prompt "Manual entry"
+ (and (not (equal default-entry ""))
+ default-entry))
'Man-completion-table
nil nil nil 'Man-topic-history default-entry)))
(if (string= input "")
@@ -1396,7 +1399,7 @@ synchronously, PROCESS is the name of the buffer where the manpage
command is run. Second argument STRING is the entire string of output."
(save-excursion
(let ((Man-buffer (process-buffer process)))
- (if (null (buffer-name Man-buffer)) ;; deleted buffer
+ (if (not (buffer-live-p Man-buffer)) ;; deleted buffer
(set-process-buffer process nil)
(with-current-buffer Man-buffer
@@ -1430,7 +1433,7 @@ manpage command."
(delete-buff nil)
message)
- (if (null (buffer-name Man-buffer)) ;; deleted buffer
+ (if (not (buffer-live-p Man-buffer)) ;; deleted buffer
(or (stringp process)
(set-process-buffer process nil))
@@ -1508,8 +1511,11 @@ manpage command."
(when delete-buff
(if (window-live-p (get-buffer-window Man-buffer t))
- (quit-restore-window
- (get-buffer-window Man-buffer t) 'kill)
+ (progn
+ (quit-restore-window
+ (get-buffer-window Man-buffer t) 'kill)
+ ;; Ensure that we end up in the correct window.
+ (select-window (old-selected-window)))
(kill-buffer Man-buffer)))
(when message
diff --git a/lisp/master.el b/lisp/master.el
index b0996bf1290..32556a535f3 100644
--- a/lisp/master.el
+++ b/lisp/master.el
@@ -3,7 +3,7 @@
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Version: 1.0.2
+;; Old-Version: 1.0.2
;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -36,12 +36,12 @@
;; SQL buffer.
;;
;; (add-hook 'sql-mode-hook
-;; (function (lambda ()
-;; (master-mode t)
-;; (master-set-slave sql-buffer))))
+;; (lambda ()
+;; (master-mode t)
+;; (master-set-slave sql-buffer)))
;; (add-hook 'sql-set-sqli-hook
-;; (function (lambda ()
-;; (master-set-slave sql-buffer))))
+;; (lambda ()
+;; (master-set-slave sql-buffer)))
;;; Thanks to all the people who helped me out:
;;
diff --git a/lisp/md4.el b/lisp/md4.el
index 925686aa756..11c91307afc 100644
--- a/lisp/md4.el
+++ b/lisp/md4.el
@@ -4,7 +4,7 @@
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Keywords: MD4
-;; Version: 1.00
+;; Old-Version: 1.00
;; Created: February 2001
;; This file is part of GNU Emacs.
@@ -22,6 +22,16 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+;;; Commentary:
+
+;; The MD4 Message-Digest Algorithm.
+;;
+;; The security of the MD4 hashing algorithm is very poor to
+;; non-existent. It was declared obsolete by RFC 6150 in 2011:
+;; https://tools.ietf.org/html/rfc6150
+;;
+;; You probably want to use `secure-hash' instead.
+
;;; Code:
;;;
@@ -33,7 +43,12 @@
(defun md4 (in n)
"Return the MD4 hash for a string IN of length N bytes.
The returned hash is 16 bytes long. N is required to handle
-strings containing the character 0."
+strings containing the character 0.
+
+The security of the MD4 hashing algorithm is very poor to
+non-existent. It was declared obsolete by RFC 6150 in 2011.
+
+You probably want to use `secure-hash' instead."
(let (m
(b (cons 0 (* n 8)))
(i 0)
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index ef64c74acda..c6ced689a67 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -540,6 +540,12 @@
(if (featurep 'ns)
(bindings--define-key menu [separator-undo] menu-bar-separator))
+ (bindings--define-key menu [undo-redo]
+ '(menu-item "Redo" undo-redo
+ :enable (and (not buffer-read-only)
+ (undo--last-change-was-undo-p buffer-undo-list))
+ :help "Redo last undone edits"))
+
(bindings--define-key menu [undo]
'(menu-item "Undo" undo
:enable (and (not buffer-read-only)
@@ -547,7 +553,7 @@
(if (eq last-command 'undo)
(listp pending-undo-list)
(consp buffer-undo-list)))
- :help "Undo last operation"))
+ :help "Undo last edits"))
menu))
@@ -661,31 +667,63 @@ PROPS are additional properties."
:button (:toggle . (and (default-boundp ',fname)
(default-value ',fname)))))
-(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
+(defmacro menu-bar-make-toggle (command variable item-name message help
+ &rest body)
+ "Define a menu-bar toggle command.
+See `menu-bar-make-toggle-command', for which this is a
+compatibility wrapper. BODY is passed in as SETTING-SEXP in that macro."
+ (declare (obsolete menu-bar-make-toggle-command "28.1"))
+ `(menu-bar-make-toggle-command ,command ,variable ,item-name ,message ,help
+ ,(and body
+ `(progn
+ ,@body))))
+
+(defmacro menu-bar-make-toggle-command (command variable item-name message
+ help
+ &optional setting-sexp
+ &rest keywords)
+ "Define a menu-bar toggle command.
+COMMAND (a symbol) is the toggle command to define.
+
+VARIABLE (a symbol) is the variable to set.
+
+ITEM-NAME (a string) is the menu-item name.
+
+MESSAGE is a format string for the toggle message, with %s for the new
+status.
+
+HELP (a string) is the `:help' tooltip text and the doc string first
+line (minus final period) for the command.
+
+SETTING-SEXP is a Lisp sexp that sets VARIABLE, or it is nil meaning
+set it according to its `defcustom' or using `set-default'.
+
+KEYWORDS is a plist for `menu-item' for keywords other than `:help'."
`(progn
- (defun ,name (&optional interactively)
+ (defun ,command (&optional interactively)
,(concat "Toggle whether to " (downcase (substring help 0 1))
- (substring help 1) ".
+ (substring help 1) ".
In an interactive call, record this option as a candidate for saving
by \"Save Options\" in Custom buffers.")
(interactive "p")
- (if ,(if body `(progn . ,body)
- `(progn
+ (if ,(if setting-sexp
+ `,setting-sexp
+ `(progn
(custom-load-symbol ',variable)
(let ((set (or (get ',variable 'custom-set) 'set-default))
(get (or (get ',variable 'custom-get) 'default-value)))
(funcall set ',variable (not (funcall get ',variable))))))
- (message ,message "enabled globally")
- (message ,message "disabled globally"))
- ;; The function `customize-mark-as-set' must only be called when
- ;; a variable is set interactively, as the purpose is to mark it as
- ;; a candidate for "Save Options", and we do not want to save options
- ;; the user have already set explicitly in his init file.
- (if interactively (customize-mark-as-set ',variable)))
- '(menu-item ,doc ,name
- :help ,help
- :button (:toggle . (and (default-boundp ',variable)
- (default-value ',variable))))))
+ (message ,message "enabled globally")
+ (message ,message "disabled globally"))
+ ;; `customize-mark-as-set' must only be called when a variable is set
+ ;; interactively, because the purpose is to mark the variable as a
+ ;; candidate for `Save Options', and we do not want to save options that
+ ;; the user has already set explicitly in the init file.
+ (when interactively (customize-mark-as-set ',variable)))
+ '(menu-item ,item-name ,command :help ,help
+ :button (:toggle . (and (default-boundp ',variable)
+ (default-value ',variable)))
+ ,@keywords)))
;; Function for setting/saving default font.
@@ -957,10 +995,11 @@ The selected font will be the default on both the existing and future frames."
:help "Indicate buffer boundaries in fringe"))
(bindings--define-key menu [indicate-empty-lines]
- (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines
- "Empty Line Indicators"
- "Indicating of empty lines %s"
- "Indicate trailing empty lines in fringe, globally"))
+ (menu-bar-make-toggle-command
+ toggle-indicate-empty-lines indicate-empty-lines
+ "Empty Line Indicators"
+ "Indicating of empty lines %s"
+ "Indicate trailing empty lines in fringe, globally"))
(bindings--define-key menu [customize]
'(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize
@@ -1405,7 +1444,7 @@ mail status in mode line"))
(bindings--define-key menu [custom-separator]
menu-bar-separator)
(bindings--define-key menu [case-fold-search]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-case-fold-search case-fold-search
"Ignore Case"
"Case-Insensitive Search %s"
@@ -1436,7 +1475,7 @@ mail status in mode line"))
(if (featurep 'system-font-setting)
(bindings--define-key menu [menu-system-font]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-use-system-font font-use-system-font
"Use System Font"
"Use system font: %s"
@@ -1462,13 +1501,15 @@ mail status in mode line"))
menu-bar-separator)
(bindings--define-key menu [debug-on-quit]
- (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit
- "Enter Debugger on Quit/C-g" "Debug on Quit %s"
- "Enter Lisp debugger when C-g is pressed"))
+ (menu-bar-make-toggle-command
+ toggle-debug-on-quit debug-on-quit
+ "Enter Debugger on Quit/C-g" "Debug on Quit %s"
+ "Enter Lisp debugger when C-g is pressed"))
(bindings--define-key menu [debug-on-error]
- (menu-bar-make-toggle toggle-debug-on-error debug-on-error
- "Enter Debugger on Error" "Debug on Error %s"
- "Enter Lisp debugger when an error is signaled"))
+ (menu-bar-make-toggle-command
+ toggle-debug-on-error debug-on-error
+ "Enter Debugger on Error" "Debug on Error %s"
+ "Enter Lisp debugger when an error is signaled"))
(bindings--define-key menu [debugger-separator]
menu-bar-separator)
@@ -1480,20 +1521,34 @@ mail status in mode line"))
(bindings--define-key menu [cursor-separator]
menu-bar-separator)
+ (bindings--define-key menu [save-desktop]
+ (menu-bar-make-toggle-command
+ toggle-save-desktop-globally desktop-save-mode
+ "Save State between Sessions"
+ "Saving desktop state %s"
+ "Visit desktop of previous session when restarting Emacs"
+ (progn
+ (require 'desktop)
+ ;; Do it by name, to avoid a free-variable
+ ;; warning during byte compilation.
+ (set-default
+ 'desktop-save-mode (not (symbol-value 'desktop-save-mode))))))
+
(bindings--define-key menu [save-place]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-save-place-globally save-place-mode
"Save Place in Files between Sessions"
"Saving place in files %s"
"Visit files of previous session when restarting Emacs"
- (require 'saveplace)
- ;; Do it by name, to avoid a free-variable
- ;; warning during byte compilation.
- (set-default
- 'save-place-mode (not (symbol-value 'save-place-mode)))))
+ (progn
+ (require 'saveplace)
+ ;; Do it by name, to avoid a free-variable
+ ;; warning during byte compilation.
+ (set-default
+ 'save-place-mode (not (symbol-value 'save-place-mode))))))
(bindings--define-key menu [uniquify]
- (menu-bar-make-toggle
+ (menu-bar-make-toggle-command
toggle-uniquify-buffer-names uniquify-buffer-name-style
"Use Directory Names in Buffer Names"
"Directory name in buffer names (uniquify) %s"
@@ -1507,7 +1562,7 @@ mail status in mode line"))
(bindings--define-key menu [cua-mode]
(menu-bar-make-mm-toggle
cua-mode
- "Use CUA Keys (Cut/Paste with C-x/C-c/C-v)"
+ "Cut/Paste with C-x/C-c/C-v (CUA Mode)"
"Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste"
(:visible (or (not (boundp 'cua-enable-cua-keys))
cua-enable-cua-keys))))
@@ -1515,8 +1570,8 @@ mail status in mode line"))
(bindings--define-key menu [cua-emulation-mode]
(menu-bar-make-mm-toggle
cua-mode
- "Shift movement mark region (CUA)"
- "Use shifted movement keys to set and extend the region"
+ "CUA Mode (without C-x/C-c/C-v)"
+ "Enable CUA Mode without rebinding C-x/C-c/C-v keys"
(:visible (and (boundp 'cua-enable-cua-keys)
(not cua-enable-cua-keys)))))
@@ -1807,6 +1862,10 @@ mail status in mode line"))
(bindings--define-key menu [list-keybindings]
'(menu-item "List Key Bindings" describe-bindings
:help "Display all current key bindings (keyboard shortcuts)"))
+ (bindings--define-key menu [list-recent-keystrokes]
+ '(menu-item "Show Recent Inputs" view-lossage
+ :help "Display last few input events and the commands \
+they ran"))
(bindings--define-key menu [describe-current-display-table]
'(menu-item "Describe Display Table" describe-current-display-table
:help "Describe the current display table"))
@@ -1822,6 +1881,9 @@ mail status in mode line"))
(bindings--define-key menu [describe-function]
'(menu-item "Describe Function..." describe-function
:help "Display documentation of function/command"))
+ (bindings--define-key menu [shortdoc-display-group]
+ '(menu-item "Function Group Overview..." shortdoc-display-group
+ :help "Display a function overview for a specific topic"))
(bindings--define-key menu [describe-key-1]
'(menu-item "Describe Key or Mouse Operation..." describe-key
;; Users typically don't identify keys and menu items...
@@ -2026,6 +2088,8 @@ key, a click, or a menu-item"))
(bindings--define-key global-map [menu-bar help-menu]
(cons (purecopy "Help") menu-bar-help-menu))
+(define-key global-map [menu-bar mouse-1] 'menu-bar-open-mouse)
+
(defun menu-bar-menu-frame-live-and-visible-p ()
"Return non-nil if the menu frame is alive and visible.
The menu frame is the frame for which we are updating the menu."
@@ -2601,6 +2665,92 @@ If FRAME is nil or not given, use the selected frame."
(global-set-key [f10] 'menu-bar-open)
+(defun menu-bar-open-mouse (event)
+ "Open the menu bar for the menu item clicked on by the mouse.
+EVENT should be a mouse down or click event.
+
+Also see `menu-bar-open', which this calls.
+This command is to be used when you click the mouse in the menubar."
+ (interactive "e")
+ ;; This only should be bound to clicks on the menu-bar, outside of
+ ;; any window.
+ (let ((window (posn-window (event-start event))))
+ (when window
+ (error "Event is inside window %s" window)))
+
+ (let* ((x-position (car (posn-x-y (event-start event))))
+ (menu-bar-item-cons (menu-bar-item-at-x x-position)))
+ (menu-bar-open nil
+ (if menu-bar-item-cons
+ (cdr menu-bar-item-cons)
+ 0))))
+
+(defun menu-bar-keymap ()
+ "Return the current menu-bar keymap.
+
+The ordering of the return value respects `menu-bar-final-items'."
+ (let ((menu-bar '())
+ (menu-end '()))
+ (map-keymap
+ (lambda (key binding)
+ (let ((pos (seq-position menu-bar-final-items key))
+ (menu-item (cons key binding)))
+ (if pos
+ ;; If KEY is the name of an item that we want to put
+ ;; last, store it separately with explicit ordering for
+ ;; sorting.
+ (push (cons pos menu-item) menu-end)
+ (push menu-item menu-bar))))
+ (lookup-key (menu-bar-current-active-maps) [menu-bar]))
+ `(keymap ,@(nreverse menu-bar)
+ ,@(mapcar #'cdr (sort menu-end
+ (lambda (a b)
+ (< (car a) (car b))))))))
+
+(defun menu-bar-current-active-maps ()
+ "Return the current active maps in the order the menu bar displays them.
+This value does not take into account `menu-bar-final-items' as that applies
+per-item."
+ ;; current-active-maps returns maps in the order local then
+ ;; global. The menu bar displays items in the opposite order.
+ (cons 'keymap (nreverse (current-active-maps))))
+
+(defun menu-bar-item-at-x (x-position)
+ "Return a cons of the form (KEY . X) for a menu item.
+The returned X is the left X coordinate for that menu item.
+
+X-POSITION is the X coordinate being queried. If nothing is clicked on,
+returns nil."
+ (let ((column 0)
+ (menu-bar (menu-bar-keymap))
+ prev-key
+ prev-column
+ found)
+ (catch 'done
+ (map-keymap
+ (lambda (key binding)
+ (when (> column x-position)
+ (setq found t)
+ (throw 'done nil))
+ (setq prev-key key)
+ (pcase binding
+ ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item.
+ `(menu-item ,name ,_cmd ;Extended menu item.
+ . ,(and props
+ (guard (let ((visible
+ (plist-get props :visible)))
+ (or (null visible)
+ (eval visible)))))))
+ (setq prev-column column
+ column (+ column (length name) 1)))))
+ menu-bar)
+ ;; Check the last menu item.
+ (when (> column x-position)
+ (setq found t)))
+ (if found
+ (cons prev-key prev-column)
+ nil)))
+
(defun buffer-menu-open ()
"Start key navigation of the buffer menu.
This is the keyboard interface to \\[mouse-buffer-menu]."
@@ -2620,6 +2770,16 @@ This is the keyboard interface to \\[mouse-buffer-menu]."
(menu-bar-buffer-vector item)))))
km))
+(defun menu-bar-define-mouse-key (map key def)
+ "Like `define-key', but adds all possible prefixes for the mouse."
+ (define-key map (vector key) def)
+ (mapc (lambda (prefix) (define-key map (vector prefix key) def))
+ ;; This list only needs to contain special window areas that
+ ;; are rendered in TTYs. No need for *-scroll-bar, *-fringe,
+ ;; or *-divider.
+ '(tab-line header-line menu-bar tab-bar mode-line vertical-line
+ left-margin right-margin)))
+
(defvar tty-menu-navigation-map
(let ((map (make-sparse-keymap)))
;; The next line is disabled because it breaks interpretation of
@@ -2654,39 +2814,33 @@ This is the keyboard interface to \\[mouse-buffer-menu]."
(define-key map [?\C-j] 'tty-menu-select)
(define-key map [return] 'tty-menu-select)
(define-key map [linefeed] 'tty-menu-select)
- (define-key map [mouse-1] 'tty-menu-select)
- (define-key map [drag-mouse-1] 'tty-menu-select)
- (define-key map [mouse-2] 'tty-menu-select)
- (define-key map [drag-mouse-2] 'tty-menu-select)
- (define-key map [mouse-3] 'tty-menu-select)
- (define-key map [drag-mouse-3] 'tty-menu-select)
- (define-key map [wheel-down] 'tty-menu-next-item)
- (define-key map [wheel-up] 'tty-menu-prev-item)
- (define-key map [wheel-left] 'tty-menu-prev-menu)
- (define-key map [wheel-right] 'tty-menu-next-menu)
- ;; The following 4 bindings are for those whose text-mode mouse
+ (menu-bar-define-mouse-key map 'mouse-1 'tty-menu-select)
+ (menu-bar-define-mouse-key map 'drag-mouse-1 'tty-menu-select)
+ (menu-bar-define-mouse-key map 'mouse-2 'tty-menu-select)
+ (menu-bar-define-mouse-key map 'drag-mouse-2 'tty-menu-select)
+ (menu-bar-define-mouse-key map 'mouse-3 'tty-menu-select)
+ (menu-bar-define-mouse-key map 'drag-mouse-3 'tty-menu-select)
+ (menu-bar-define-mouse-key map 'wheel-down 'tty-menu-next-item)
+ (menu-bar-define-mouse-key map 'wheel-up 'tty-menu-prev-item)
+ (menu-bar-define-mouse-key map 'wheel-left 'tty-menu-prev-menu)
+ (menu-bar-define-mouse-key map 'wheel-right 'tty-menu-next-menu)
+ ;; The following 6 bindings are for those whose text-mode mouse
;; lack the wheel.
- (define-key map [S-mouse-1] 'tty-menu-next-item)
- (define-key map [S-drag-mouse-1] 'tty-menu-next-item)
- (define-key map [S-mouse-2] 'tty-menu-prev-item)
- (define-key map [S-drag-mouse-2] 'tty-menu-prev-item)
- (define-key map [S-mouse-3] 'tty-menu-prev-item)
- (define-key map [S-drag-mouse-3] 'tty-menu-prev-item)
- (define-key map [header-line mouse-1] 'tty-menu-select)
- (define-key map [header-line drag-mouse-1] 'tty-menu-select)
+ (menu-bar-define-mouse-key map 'S-mouse-1 'tty-menu-next-item)
+ (menu-bar-define-mouse-key map 'S-drag-mouse-1 'tty-menu-next-item)
+ (menu-bar-define-mouse-key map 'S-mouse-2 'tty-menu-prev-item)
+ (menu-bar-define-mouse-key map 'S-drag-mouse-2 'tty-menu-prev-item)
+ (menu-bar-define-mouse-key map 'S-mouse-3 'tty-menu-prev-item)
+ (menu-bar-define-mouse-key map 'S-drag-mouse-3 'tty-menu-prev-item)
;; The down-mouse events must be bound to tty-menu-ignore, so that
;; only releasing the mouse button pops up the menu.
- (define-key map [mode-line down-mouse-1] 'tty-menu-ignore)
- (define-key map [mode-line down-mouse-2] 'tty-menu-ignore)
- (define-key map [mode-line down-mouse-3] 'tty-menu-ignore)
- (define-key map [mode-line C-down-mouse-1] 'tty-menu-ignore)
- (define-key map [mode-line C-down-mouse-2] 'tty-menu-ignore)
- (define-key map [mode-line C-down-mouse-3] 'tty-menu-ignore)
- (define-key map [down-mouse-1] 'tty-menu-ignore)
- (define-key map [C-down-mouse-1] 'tty-menu-ignore)
- (define-key map [C-down-mouse-2] 'tty-menu-ignore)
- (define-key map [C-down-mouse-3] 'tty-menu-ignore)
- (define-key map [mouse-movement] 'tty-menu-mouse-movement)
+ (menu-bar-define-mouse-key map 'down-mouse-1 'tty-menu-ignore)
+ (menu-bar-define-mouse-key map 'down-mouse-2 'tty-menu-ignore)
+ (menu-bar-define-mouse-key map 'down-mouse-3 'tty-menu-ignore)
+ (menu-bar-define-mouse-key map 'C-down-mouse-1 'tty-menu-ignore)
+ (menu-bar-define-mouse-key map 'C-down-mouse-2 'tty-menu-ignore)
+ (menu-bar-define-mouse-key map 'C-down-mouse-3 'tty-menu-ignore)
+ (menu-bar-define-mouse-key map 'mouse-movement 'tty-menu-mouse-movement)
map)
"Keymap used while processing TTY menus.")
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index dad3d1ec560..d30441f91a8 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -324,7 +324,7 @@
* mh-customize.el (mh-show-pgg-good-face)
(mh-show-pgg-unknown-face, mh-show-pgg-bad-face): Faces added to
- highlight buttons introduced for encrpted or signed MIME parts.
+ highlight buttons introduced for encrypted or signed MIME parts.
2005-03-19 Bill Wohler <wohler@newt.com>
@@ -428,7 +428,7 @@
2004-11-28 Jeffrey C Honig <jch@honig.net>
* mh-comp.el (mh-complete-word): Kill the *Completions* buffer in
- any cases where we belive we are done with it. Not perfect, but
+ any cases where we believe we are done with it. Not perfect, but
better than just leaving it around.
2004-11-08 Satyaki Das <satyaki@theforce.stanford.edu>
@@ -818,7 +818,7 @@
* Makefile:
(mh-e-autoloads.el): Add target to make `mh-e-autoloads.el', a
- file containg usual entry commands into MH-E to be used for users
+ file containing usual entry commands into MH-E to be used for users
installing MH-E separately from Emacs.
(XEMACS_LOADDEFS_FILE): New. Used to generate mh-loaddefs.el
in XEmacs.
@@ -1201,7 +1201,7 @@
2003-11-01 Peter S Galbraith <psg@debian.org>
- * Makefile: Add target to make `mh-startup.el', a file containg
+ * Makefile: Add target to make `mh-startup.el', a file containing
usual entry commands into MH-E to be used for users installing
MH-E separately from Emacs.
@@ -1914,7 +1914,7 @@
2003-08-18 Peter S Galbraith <psg@debian.org>
* mh-comp.el (mh-letter-mode): Call `mh-find-path unconditionally,
- like elsewehere in MH-E.
+ like elsewhere in MH-E.
* mh-utils.el (mh-find-path): Run setup code only if
`mh-find-path-run' is nil such that this is only done once.
@@ -2588,7 +2588,7 @@
2003-07-24 Satyaki Das <satyakid@stanford.edu>
* mh-e.el (mh-folder-message-menu, mh-folder-folder-menu): Use the
- predicate mh-outstanding-commands-p instead of its exapansion.
+ predicate mh-outstanding-commands-p instead of its expansion.
Also use the same label in both menus.
(mh-outstanding-commands-p): Generalized so that it will work in
mh-show-mode buffers as well.
@@ -3915,7 +3915,7 @@
2003-04-22 Satyaki Das <satyaki@theforce.stanford.edu>
* mh-utils.el (mh-normalize-folder-name): Make the completion
- code work properly with XEmacs. This change is neeeded since
+ code work properly with XEmacs. This change is needed since
split-string behaves differently in XEmacs than it does in GNU
Emacs.
(mh-exec-cmd-error): Add a comment, so that we change it later on.
@@ -7391,7 +7391,7 @@
numbers.
(mh-cmd-note): Mention mh-set-cmd-note in docstring. Also suggest
that it is updated dynamically only if mh-scan-format-file is t.
- (mh-set-cmd-note): Grammer fix in docstring.
+ (mh-set-cmd-note): Grammar fix in docstring.
(mh-cmd-note): Noted that the first column is column number 0.
* mh-e.el (mh-scan-format-file): Added information about
@@ -7696,7 +7696,7 @@
* mh-identity.el: New file. Multiple Identify support for MH-E.
Used to easily set different fields such as From and Organization,
- as well as diffrent signature files. This file won't be included
+ as well as different signature files. This file won't be included
with V7.0.
2002-11-02 Bill Wohler <wohler@newt.com>
@@ -9458,10 +9458,10 @@
2002-07-15 Mark D. Baushke <mdb@gnu.org>
- * mh-utils.el (mm-decode): Use load for the Non-fatal depencency
+ * mh-utils.el (mm-decode): Use load for the Non-fatal dependency
on the mm-decode library.
* mh-mime.el (mm-decode, mm-uu, mm-view): Use load for the
- Non-fatal depencencies on the mm-decode, mm-uu and mm-view
+ Non-fatal dependencies on the mm-decode, mm-uu and mm-view
libraries.
2002-07-15 Satyaki Das <satyaki@theforce.stanford.edu>
@@ -11356,7 +11356,7 @@
4 was silly for my case.
* mh-e.el (mh-update-sequences): Check for nil value of
mh-current-folder, which happens if mh-summary-height < 4
- although I haven't tracked doen why that happens.
+ although I haven't tracked down why that happens.
2001-10-22 Peter S Galbraith <psg@debian.org>
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index f7e30bfbb3d..8a69adbb756 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -305,6 +305,7 @@ message and scan line."
(let ((draft-buffer (current-buffer))
(file-name buffer-file-name)
(config mh-previous-window-config)
+ ;; FIXME this is subtly different to select-message-coding-system.
(coding-system-for-write
(if (fboundp 'select-message-coding-system)
(select-message-coding-system) ; Emacs has this since at least 21.1
@@ -318,7 +319,7 @@ message and scan line."
(or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
(and (default-boundp 'buffer-file-coding-system)
(default-value 'buffer-file-coding-system))
- 'iso-latin-1)))))
+ 'utf-8)))))
;; Older versions of spost do not support -msgid and -mime.
(unless mh-send-uses-spost-flag
;; Adding a Message-ID field looks good, makes it easier to search for
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index dd05d691c91..3ac5c8f7aed 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -1550,7 +1550,7 @@ as the result is undefined."
,(append
'(radio)
(mapcar
- (function (lambda (arg) `(const ,arg)))
+ (lambda (arg) `(const ,arg))
(mapcar 'car mh-identity-list))))
(cons :tag "Fcc Field"
(const "fcc")
@@ -1577,7 +1577,7 @@ See `mh-identity-list'."
:type (append
'(radio)
(cons '(const :tag "None" nil)
- (mapcar (function (lambda (arg) `(const ,arg)))
+ (mapcar (lambda (arg) `(const ,arg))
(mapcar 'car mh-identity-list))))
:group 'mh-identity
:package-version '(MH-E . "7.1"))
@@ -1914,7 +1914,7 @@ of images into \"X-Face:\" header fields (see URL
Use the \"make-face\" script to convert a JPEG image to the higher
resolution, color, \"Face:\" header field (see URL
-`http://quimby.gnus.org/circus/face/make-face').
+`https://quimby.gnus.org/circus/face/make-face').
The URL of any image can be used for the \"X-Image-URL:\" field and no
processing of the image is required.
@@ -2420,11 +2420,11 @@ of citations entirely, choose \"None\"."
;; These entries have been intentionally excluded by the developers.
;; "Comments:" ; RFC 822 (or later) - show this one
-;; "Fax:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
-;; "Mail-System-Version:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
-;; "Mailer:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+;; "Fax:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+;; "Mail-System-Version:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+;; "Mailer:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
;; "Organization:" ;
-;; "Phone:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+;; "Phone:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
;; "Reply-By:" ; RFC 2156
;; "Reply-To:" ; RFC 822 (or later)
;; "Sender:" ;
@@ -2437,13 +2437,13 @@ of citations entirely, choose \"None\"."
;; Mention source, if known.
(defvar mh-invisible-header-fields-internal
'(
- "Abuse-Reports-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Abuse-Reports-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Accept-Language:"
"AcceptLanguage:"
"Accreditor:" ; Habeas
"Also-Control:" ; H. Spencer: News Article Format and Transmission, June 1994
"Alternate-recipient:" ; RFC 2156
- "Approved-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Approved-By:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Approved:" ; RFC 1036
"Article-Names:" ; H. Spencer: News Article Format and Transmission, June 1994
"Article-Updates:" ; H. Spencer: News Article Format and Transmission, June 1994
@@ -2454,7 +2454,7 @@ of citations entirely, choose \"None\"."
"Bounces-To:"
"Bounces_to:"
"Bytes:"
- "Cancel-Key:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Cancel-Key:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Cancel-Lock:" ; NNTP posts
"Comment:" ; Shows up with DomainKeys
"Content-" ; RFC 2045, 1123, 1766, 1864, 2045, 2110, 2156, 2183, 2912
@@ -2475,14 +2475,14 @@ of citations entirely, choose \"None\"."
"DomainKey-Signature:"
"Encoding:" ; RFC 1505
"Envelope-to:"
- "Errors-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Errors-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Expires:" ; RFC 1036
"Expiry-Date:" ; RFC 2156
"Face:" ; Gnus Face header
"Followup-To:" ; RFC 1036
- "For-Approval:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "For-Comment:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "For-Handling:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "For-Approval:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "For-Comment:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "For-Handling:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Forwarded:" ; MH
"From " ; sendmail
"Generate-Delivery-Report:" ; RFC 2156
@@ -2493,12 +2493,12 @@ of citations entirely, choose \"None\"."
"Language:" ; RFC 2156
"Lines:" ; RFC 1036
"List-" ; RFC 2369, 2919
- "Mail-Copies-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "Mail-Followup-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Mail-Copies-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Mail-Followup-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Mail-from:" ; MH
- "Mail-Reply-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Mail-Reply-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Mailing-List:" ; Egroups/yahoogroups mailing list manager
- "Message-Content:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Message-Content:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Message-ID:" ; RFC 822 (or later)
"Message-Type:" ; RFC 2156
"Mime-Version" ; RFC 2045
@@ -2516,42 +2516,42 @@ of citations entirely, choose \"None\"."
"Original-Recipient:" ; RFC 2298
"Original-To:" ; mail to news
"Original-X-" ; mail to news
- "Origination-Client:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "Originator:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Origination-Client:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Originator:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"P1-Content-Type:" ; X400
"P1-Message-Id:" ; X400
"P1-Recipient:" ; X400
"Path:" ; RFC 1036
"Pics-Label:" ; W3C
- "Posted-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "Precedence:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Posted-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Precedence:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Prev-Resent" ; MH
"Prevent-NonDelivery-Report:" ; RFC 2156
"Priority:" ; RFC 2156
- "Read-Receipt-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Read-Receipt-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Received-SPF:" ; Gmail
"Received:" ; RFC 822 (or later)
"References:" ; RFC 822 (or later)
- "Registered-Mail-Reply-Requested-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Registered-Mail-Reply-Requested-By:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Remailed-" ; MH
- "Replaces:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Replaces:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Replied:" ; MH
"Resent-" ; RFC 822 (or later)
"Return-Path:" ; RFC 822 (or later)
- "Return-Receipt-Requested:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "Return-Receipt-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Return-Receipt-Requested:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Return-Receipt-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Seal-Send-Time:"
"See-Also:" ; H. Spencer: News Article Format and Transmission, June 1994
"Sensitivity:" ; RFC 2156, 2421
- "Speech-Act:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Speech-Act:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Status:" ; sendmail
"Supersedes:" ; H. Spencer: News Article Format and Transmission, June 1994
- "Telefax:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Telefax:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Thread-"
"Thread-Index:"
"Thread-Topic:"
- "Translated-By:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "Translation-Of:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Translated-By:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "Translation-Of:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"Ua-Content-Id:" ; X400
"Via:" ; MH
"X-Abuse-and-DMCA-"
@@ -2559,7 +2559,7 @@ of citations entirely, choose \"None\"."
"X-Accept-Language:" ; Netscape/Mozilla
"X-Ack:"
"X-ACL-Warn:" ; http://www.exim.org
- "X-Admin:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Admin:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Administrivia-To:"
"X-AMAZON" ; Amazon.com
"X-AnalysisOut:" ; Exchange
@@ -2594,9 +2594,9 @@ of citations entirely, choose \"None\"."
"X-CanIt-Geo:" ; IEEE spam filter
"X-Cloudmark-SP-" ; Cloudmark (www.cloudmark.com)
"X-Comment:" ; AT&T Mailennium
- "X-Complaints-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Complaints-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Completed:"
- "X-Confirm-Reading-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Confirm-Reading-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Content-Filtered-By:"
"X-ContentStamp:" ; NetZero
"X-Country-Chain:" ; http://www.declude.com/x-note.htm
@@ -2622,13 +2622,13 @@ of citations entirely, choose \"None\"."
"X-Email-Type-Id:" ; Paypal http://www.paypal.com
"X-Enigmail-Version:"
"X-Envelope-Date:" ; GNU mailutils
- "X-Envelope-From:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Envelope-From:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Envelope-Sender:"
- "X-Envelope-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Envelope-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-EviteMessageId:" ; evite.com
"X-Evolution:" ; Evolution mail client
"X-ExtLoop"
- "X-Face:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Face:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Facebook" ; Facebook
"X-FB-SS:"
"X-fmx-"
@@ -2652,7 +2652,7 @@ of citations entirely, choose \"None\"."
"X-Identity:" ; http://www.declude.com/x-note.htm
"X-IEEE-UCE-" ; IEEE spam filter
"X-Image-URL:"
- "X-IMAP:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-IMAP:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Info:" ; NTMail
"X-IronPort-" ; IronPort AV
"X-ISI-4-30-3-MailScanner:"
@@ -2662,12 +2662,12 @@ of citations entirely, choose \"None\"."
"X-Juno-" ; Juno
"X-Key:"
"X-Launchpad-" ; plaunchpad.net
- "X-List-Host:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-List-Host:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-List-Subscribe:" ; Unknown mailing list managers
"X-List-Unsubscribe:" ; Unknown mailing list managers
"X-Listprocessor-" ; ListProc(tm) by CREN
- "X-Listserver:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "X-Loop:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Listserver:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Loop:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Lrde-Mailscanner:"
"X-Lumos-SenderID:" ; Roving ConstantContact
"X-mail_abuse_inquiries:" ; http://www.salesforce.com
@@ -2693,18 +2693,18 @@ of citations entirely, choose \"None\"."
"X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX
"X-MHE-Checksum:" ; Checksum added during index search
"X-MIME-Autoconverted:" ; sendmail
- "X-MIMEOLE:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/sendmail
+ "X-MIMEOLE:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/sendmail
"X-MIMETrack:"
"X-Mms-" ; T-Mobile pictures
"X-Mozilla-Status:" ; Netscape/Mozilla
"X-MS-" ; MS Outlook
"X-Msmail-" ; MS Outlook
- "X-MSMail-Priority" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-MSMail-Priority" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-MXL-Hash:"
"X-NAI-Spam-" ; Network Associates Inc. SpamKiller
"X-News:" ; News
- "X-Newsreader:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "X-No-Archive:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Newsreader:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-No-Archive:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Notes-Item:" ; Lotus Notes Domino structured header
"X-Notification-" ; Google+
"X-Notifications:" ; Google+
@@ -2713,7 +2713,7 @@ of citations entirely, choose \"None\"."
"X-ORBL:"
"X-Orcl-Content-Type:"
"X-Organization:"
- "X-Original-Arrival-Type:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Original-Arrival-Type:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Original-Complaints-To:"
"X-Original-Date:" ; SourceForge mailing list manager
"X-Original-To:"
@@ -2733,10 +2733,10 @@ of citations entirely, choose \"None\"."
"X-Provags-ID:"
"X-PSTN-"
"X-Qotd-" ; User added
- "X-RCPT-TO:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-RCPT-TO:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Received-Date:"
"X-Received:"
- "X-Report-Abuse-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Report-Abuse-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Request-"
"X-Resolved-to:" ; fastmail.fm
"X-Return-Path-Hint:" ; Roving ConstantContact
@@ -2753,7 +2753,7 @@ of citations entirely, choose \"None\"."
"X-SBRule:" ; Spam
"X-Scanned-By:"
"X-Sender-ID:" ; Google+
- "X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-Sender:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Sendergroup:" ; Cisco Email Security (formerly IronPort; http://www.ironport.com)
"X-Server-Date:"
"X-Server-Uuid:"
@@ -2776,11 +2776,11 @@ of citations entirely, choose \"None\"."
"X-TM-IMSS-Message-ID:" ; http://www.trendmicro.com
"X-Trace:"
"X-UID"
- "X-UIDL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-UIDL:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Unity"
"X-UNTD-" ; NetZero
- "X-URI:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "X-URL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-URI:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-URL:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-USANET-" ; usa.net
"X-Usenet-Provider"
"X-UserInfo1:"
@@ -2792,7 +2792,7 @@ of citations entirely, choose \"None\"."
"X-VSMLoop:" ; NTMail
"X-WebTV-Signature:"
"X-Wss-Id:" ; Worldtalk gateways
- "X-X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/
+ "X-X-Sender:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-XPT-XSL-Name:" ; Paypal http://www.paypal.com
"X-xsi-"
"X-XWALL-" ; http://www.dataenter.co.at/doc/xwall_undocumented_config.htm
@@ -3036,7 +3036,7 @@ supports it.
The first header field used, if present, is the Gnus-specific
\"Face:\" field. The \"Face:\" field appeared in GNU Emacs 21 and
XEmacs. For more information, see URL
-`http://quimby.gnus.org/circus/face/'. Next is the traditional
+`https://quimby.gnus.org/circus/face/'. Next is the traditional
\"X-Face:\" header field. The display of this field requires the
\"uncompface\" program (see URL
`ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z'). Recent
@@ -3049,7 +3049,7 @@ header field if neither the \"Face:\" nor the \"X-Face:\" fields are
present. The display of the images requires \"wget\" (see URL
`https://www.gnu.org/software/wget/wget.html'), \"fetch\", or \"curl\"
to fetch the image and the \"convert\" program from the ImageMagick
-suite (see URL `http://www.imagemagick.org/'). Of the three header
+suite (see URL `https://www.imagemagick.org/'). Of the three header
fields this is the most efficient in terms of network usage since the
image doesn't need to be transmitted with every single mail.
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index a3fbb89bb88..d4577807c92 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -148,7 +148,7 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
"Put all following messages with same subject in sequence 'subject.
If arg ALL is t, move to beginning of folder buffer to collect all
messages.
-If arg ALL is nil, collect only messages fron current one on forward.
+If arg ALL is nil, collect only messages from current one on forward.
Return number of messages put in the sequence:
@@ -198,7 +198,7 @@ It would be desirable to avoid hard-coding this.")
This function only works with an unthreaded folder. If arg ALL is
t, move to beginning of folder buffer to collect all messages. If
-arg ALL is nil, collect only messages fron current one on
+arg ALL is nil, collect only messages from current one on
forward.
Return number of messages put in the sequence:
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index 41c8489e16b..a8fb46d8d98 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -794,9 +794,9 @@ If SAVE-REFILES is non-nil, then keep the sequences
that note messages to be refiled."
(let ((seqs ()))
(cond (save-refiles
- (mh-mapc (function (lambda (seq) ; Save the refiling sequences
- (if (mh-folder-name-p (mh-seq-name seq))
- (setq seqs (cons seq seqs)))))
+ (mh-mapc (lambda (seq) ; Save the refiling sequences
+ (if (mh-folder-name-p (mh-seq-name seq))
+ (setq seqs (cons seq seqs))))
mh-seq-list)))
(save-excursion
(if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index 3c07d426b7d..7536f949e76 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -219,8 +219,7 @@ Sets the current buffer to the show buffer."
(erase-buffer)
;; Changing contents, so this hook needs to be reinitialized.
;; pgp.el uses this.
- (if (boundp 'write-contents-hooks) ;Emacs 19
- (kill-local-variable 'write-contents-hooks))
+ (kill-local-variable 'write-contents-functions)
(font-lock-mode -1)
(mh-show-mode)
(if formfile
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 7e0981bed3a..0732a16dc7d 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -307,7 +307,7 @@ The function will expand out parent folders of FOLDER if needed."
(mh-speed-toggle))
(goto-char (gethash prefix mh-speed-folder-map))))
(while suffix-list
- ;; We always need atleast one toggle. We need two if the directory list
+ ;; We always need at least one toggle. We need two if the directory list
;; is stale since a folder was added.
(when (equal prefix (get-text-property (mh-line-beginning-position)
'mh-folder))
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index fc30187245d..e6ee87b8411 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -26,10 +26,10 @@
;; The threading portion of this files tries to implement the
;; algorithm described at:
-;; http://www.jwz.org/doc/threading.html
+;; https://www.jwz.org/doc/threading.html
;; It also begins to implement the threading section of the IMAP -
;; SORT and THREAD Extensions RFC at:
-;; http://tools.ietf.org/html/rfc5256
+;; https://tools.ietf.org/html/rfc5256
;; The implementation lacks the reference and subject canonicalization
;; of the RFC.
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index 01672c027f0..363899d2656 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -36,10 +36,24 @@
(defvar minibuffer-eldef-shorten-default)
(defun minibuffer-default--in-prompt-regexps ()
- `(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'"
- 1 ,(if minibuffer-eldef-shorten-default " [\\2]"))
- ("([^(]+?\\(, default\\(?: is\\)? \\(.*\\)\\)):? \\'" 1)
- ("\\( \\[.*\\]\\):? *\\'" 1)))
+ (cons
+ (list
+ (concat
+ "\\("
+ (if (string-match "%s" minibuffer-default-prompt-format)
+ (concat
+ (regexp-quote (substring minibuffer-default-prompt-format
+ 0 (match-beginning 0)))
+ "\\(.*?\\)"
+ (regexp-quote (substring minibuffer-default-prompt-format
+ (match-end 0))))
+ (regexp-quote minibuffer-default-prompt-format))
+ "\\): ")
+ 1 (and minibuffer-eldef-shorten-default " [\\2]"))
+ `(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'"
+ 1 ,(if minibuffer-eldef-shorten-default " [\\2]"))
+ ("([^(]+?\\(, default\\(?: is\\)? \\(.*\\)\\)):? \\'" 1)
+ ("\\( \\[.*\\]\\):? *\\'" 1))))
(defcustom minibuffer-eldef-shorten-default nil
"If non-nil, shorten \"(default ...)\" to \"[...]\" in minibuffer prompts."
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 942fb019fe2..9d57a817b25 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -685,13 +685,6 @@ for use at QPOS."
completions)
qboundary))))
-;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b))
-;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun))
-(define-obsolete-function-alias
- 'complete-in-turn #'completion-table-in-turn "23.1")
-(define-obsolete-function-alias
- 'dynamic-completion-table #'completion-table-dynamic "23.1")
-
;;; Minibuffer completion
(defgroup minibuffer nil
@@ -708,7 +701,7 @@ The text is displayed for `minibuffer-message-timeout' seconds,
or until the next input event arrives, whichever comes first.
Enclose MESSAGE in [...] if this is not yet the case.
If ARGS are provided, then pass MESSAGE through `format-message'."
- (if (not (minibufferp (current-buffer)))
+ (if (not (minibufferp (current-buffer) t))
(progn
(if args
(apply #'message message args)
@@ -1078,10 +1071,16 @@ in the last `cdr'."
(defun completion--replace (beg end newtext)
"Replace the buffer text between BEG and END with NEWTEXT.
Moves point to the end of the new text."
- ;; The properties on `newtext' include things like
- ;; completions-first-difference, which we don't want to include
- ;; upon insertion.
- (set-text-properties 0 (length newtext) nil newtext)
+ ;; The properties on `newtext' include things like the
+ ;; `completions-first-difference' face, which we don't want to
+ ;; include upon insertion.
+ (if minibuffer-allow-text-properties
+ ;; If we're preserving properties, then just remove the faces
+ ;; and other properties added by the completion machinery.
+ (remove-text-properties 0 (length newtext) '(face completion-score)
+ newtext)
+ ;; Remove all text properties.
+ (set-text-properties 0 (length newtext) nil newtext))
;; Maybe this should be in subr.el.
;; You'd think this is trivial to do, but details matter if you want
;; to keep markers "at the right place" and be robust in the face of
@@ -1776,9 +1775,6 @@ It also eliminates runs of equal strings."
;; Round up to a whole number of columns.
(* colwidth (ceiling length colwidth))))))))))))
-(defvar completion-common-substring nil)
-(make-obsolete-variable 'completion-common-substring nil "23.1")
-
(defvar completion-setup-hook nil
"Normal hook run at the end of setting up a completion list buffer.
When this hook is run, the current buffer is the one in which the
@@ -1870,11 +1866,7 @@ It can find the completion buffer in `standard-output'."
(insert "Possible completions are:\n")
(completion--insert-strings completions))))
- ;; The hilit used to be applied via completion-setup-hook, so there
- ;; may still be some code that uses completion-common-substring.
- (with-no-warnings
- (let ((completion-common-substring common-substring))
- (run-hooks 'completion-setup-hook)))
+ (run-hooks 'completion-setup-hook)
nil)
(defvar completion-extra-properties nil
@@ -1974,12 +1966,13 @@ variables.")
(plist-get completion-extra-properties
:annotation-function)
completion-annotate-function))
+ (mainbuf (current-buffer))
;; If the *Completions* buffer is shown in a new
;; window, mark it as softly-dedicated, so bury-buffer in
;; minibuffer-hide-completions will know whether to
;; delete the window or not.
(display-buffer-mark-dedicated 'soft))
- (with-displayed-buffer-window
+ (with-current-buffer-window
"*Completions*"
;; This is a copy of `display-buffer-fallback-action'
;; where `display-buffer-use-some-window' is replaced
@@ -1993,66 +1986,69 @@ variables.")
,(if (eq (selected-window) (minibuffer-window))
'display-buffer-at-bottom
'display-buffer-below-selected))
- ,(if temp-buffer-resize-mode
- '(window-height . resize-temp-buffer-window)
- '(window-height . fit-window-to-buffer))
- ,(when temp-buffer-resize-mode
- '(preserve-size . (nil . t))))
- nil
- ;; Remove the base-size tail because `sort' requires a properly
- ;; nil-terminated list.
- (when last (setcdr last nil))
- (setq completions
- ;; FIXME: This function is for the output of all-completions,
- ;; not completion-all-completions. Often it's the same, but
- ;; not always.
- (let ((sort-fun (completion-metadata-get
- all-md 'display-sort-function)))
- (if sort-fun
- (funcall sort-fun completions)
- (sort completions 'string-lessp))))
- (when afun
- (setq completions
- (mapcar (lambda (s)
- (let ((ann (funcall afun s)))
- (if ann (list s ann) s)))
- completions)))
-
- (with-current-buffer standard-output
- (set (make-local-variable 'completion-base-position)
- (list (+ start base-size)
- ;; FIXME: We should pay attention to completion
- ;; boundaries here, but currently
- ;; completion-all-completions does not give us the
- ;; necessary information.
- end))
- (set (make-local-variable 'completion-list-insert-choice-function)
- (let ((ctable minibuffer-completion-table)
- (cpred minibuffer-completion-predicate)
- (cprops completion-extra-properties))
- (lambda (start end choice)
- (unless (or (zerop (length prefix))
- (equal prefix
- (buffer-substring-no-properties
- (max (point-min)
- (- start (length prefix)))
- start)))
- (message "*Completions* out of date"))
- ;; FIXME: Use `md' to do quoting&terminator here.
- (completion--replace start end choice)
- (let* ((minibuffer-completion-table ctable)
- (minibuffer-completion-predicate cpred)
- (completion-extra-properties cprops)
- (result (concat prefix choice))
- (bounds (completion-boundaries
- result ctable cpred "")))
- ;; If the completion introduces a new field, then
- ;; completion is not finished.
- (completion--done result
- (if (eq (car bounds) (length result))
- 'exact 'finished)))))))
-
- (display-completion-list completions))))
+ ,(if temp-buffer-resize-mode
+ '(window-height . resize-temp-buffer-window)
+ '(window-height . fit-window-to-buffer))
+ ,(when temp-buffer-resize-mode
+ '(preserve-size . (nil . t)))
+ (body-function
+ . ,#'(lambda (_window)
+ (with-current-buffer mainbuf
+ ;; Remove the base-size tail because `sort' requires a properly
+ ;; nil-terminated list.
+ (when last (setcdr last nil))
+ (setq completions
+ ;; FIXME: This function is for the output of all-completions,
+ ;; not completion-all-completions. Often it's the same, but
+ ;; not always.
+ (let ((sort-fun (completion-metadata-get
+ all-md 'display-sort-function)))
+ (if sort-fun
+ (funcall sort-fun completions)
+ (sort completions 'string-lessp))))
+ (when afun
+ (setq completions
+ (mapcar (lambda (s)
+ (let ((ann (funcall afun s)))
+ (if ann (list s ann) s)))
+ completions)))
+
+ (with-current-buffer standard-output
+ (set (make-local-variable 'completion-base-position)
+ (list (+ start base-size)
+ ;; FIXME: We should pay attention to completion
+ ;; boundaries here, but currently
+ ;; completion-all-completions does not give us the
+ ;; necessary information.
+ end))
+ (set (make-local-variable 'completion-list-insert-choice-function)
+ (let ((ctable minibuffer-completion-table)
+ (cpred minibuffer-completion-predicate)
+ (cprops completion-extra-properties))
+ (lambda (start end choice)
+ (unless (or (zerop (length prefix))
+ (equal prefix
+ (buffer-substring-no-properties
+ (max (point-min)
+ (- start (length prefix)))
+ start)))
+ (message "*Completions* out of date"))
+ ;; FIXME: Use `md' to do quoting&terminator here.
+ (completion--replace start end choice)
+ (let* ((minibuffer-completion-table ctable)
+ (minibuffer-completion-predicate cpred)
+ (completion-extra-properties cprops)
+ (result (concat prefix choice))
+ (bounds (completion-boundaries
+ result ctable cpred "")))
+ ;; If the completion introduces a new field, then
+ ;; completion is not finished.
+ (completion--done result
+ (if (eq (car bounds) (length result))
+ 'exact 'finished)))))))
+
+ (display-completion-list completions)))))
+ nil)))
nil))
(defun minibuffer-hide-completions ()
@@ -2376,8 +2372,6 @@ The completion method is determined by `completion-at-point-functions'."
Gets combined either with `minibuffer-local-completion-map' or
with `minibuffer-local-must-match-map'.")
-(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
- 'minibuffer-local-filename-must-match-map "23.1")
(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap))
(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1")
@@ -2551,11 +2545,6 @@ same as `substitute-in-file-name'."
all))))))
(file-error nil))) ;PCM often calls with invalid directories.
-(defvar read-file-name-predicate nil
- "Current predicate used by `read-file-name-internal'.")
-(make-obsolete-variable 'read-file-name-predicate
- "use the regular PRED argument" "23.2")
-
(defun completion--sifn-requote (upos qstr)
;; We're looking for `qpos' such that:
;; (equal (substring (substitute-in-file-name qstr) 0 upos)
@@ -3045,6 +3034,19 @@ the commands start with a \"-\" or a SPC."
:version "24.1"
:type 'boolean)
+(defcustom minibuffer-default-prompt-format " (default %s)"
+ "Format string used to output \"default\" values.
+When prompting for input, there will often be a default value,
+leading to prompts like \"Number of articles (default 50): \".
+The \"default\" part of that prompt is controlled by this
+variable, and can be set to, for instance, \" [%s]\" if you want
+a shorter displayed prompt, or \"\", if you don't want to display
+the default at all.
+
+This variable is used by the `format-prompt' function."
+ :version "28.1"
+ :type 'string)
+
(defun completion-pcm--pattern-trivial-p (pattern)
(and (stringp (car pattern))
;; It can be followed by `point' and "" and still be trivial.
@@ -3114,12 +3116,12 @@ or a symbol, see `completion-pcm--merge-completions'."
(while p
(pcase p
(`(,(or 'any 'any-delim) point . ,rest) (setq p `(point . ,rest)))
- ;; This is not just a performance improvement: it also turns
- ;; a terminating `point' into an implicit `any', which
- ;; affects the final position of point (because `point' gets
- ;; turned into a non-greedy ".*?" regexp whereas we need
- ;; it the be greedy when it's at the end, see bug#38458).
- (`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'.
+ ;; This is not just a performance improvement: it turns a
+ ;; terminating `point' into an implicit `any', which affects
+ ;; the final position of point (because `point' gets turned
+ ;; into a non-greedy ".*?" regexp whereas we need it to be
+ ;; greedy when it's at the end, see bug#38458).
+ (`(point) (setq p nil)) ;Implicit terminating `any'.
(_ (push (pop p) n))))
(nreverse n)))
@@ -3862,6 +3864,29 @@ the minibuffer was activated, and execute the forms."
(with-minibuffer-selected-window
(scroll-other-window-down arg)))
+(defun format-prompt (prompt default &rest format-args)
+ "Format PROMPT with DEFAULT according to `minibuffer-default-prompt-format'.
+If FORMAT-ARGS is nil, PROMPT is used as a plain string. If
+FORMAT-ARGS is non-nil, PROMPT is used as a format control
+string, and FORMAT-ARGS are the arguments to be substituted into
+it. See `format' for details.
+
+If DEFAULT is a list, the first element is used as the default.
+If not, the element is used as is.
+
+If DEFAULT is nil, no \"default value\" string is included in the
+return value."
+ (concat
+ (if (null format-args)
+ prompt
+ (apply #'format prompt format-args))
+ (and default
+ (format minibuffer-default-prompt-format
+ (if (consp default)
+ (car default)
+ default)))
+ ": "))
+
(provide 'minibuffer)
;;; minibuffer.el ends here
diff --git a/lisp/misc.el b/lisp/misc.el
index 05244a6ea2f..03395781a51 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -1,4 +1,4 @@
-;;; misc.el --- some nonstandard editing and utility commands for Emacs
+;;; misc.el --- some nonstandard editing and utility commands for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1989, 2001-2020 Free Software Foundation, Inc.
@@ -69,7 +69,9 @@ The characters copied are inserted in the buffer before point."
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found.
Ignores CHAR at point."
- (interactive "p\ncZap up to char: ")
+ (interactive (list (prefix-numeric-value current-prefix-arg)
+ (read-char-from-minibuffer "Zap up to char: "
+ nil 'read-char-history)))
(let ((direction (if (>= arg 0) 1 -1)))
(kill-region (point)
(progn
@@ -125,7 +127,7 @@ upper atmosphere. These cause momentary pockets of higher-pressure
air to form, which act as lenses that deflect incoming cosmic rays,
focusing them to strike the drive platter and flip the desired bit.
You can type `M-x butterfly C-M-c' to run it. This is a permuted
-variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'."
+variation of `C-x M-c M-butterfly' from url `https://xkcd.com/378/'."
(interactive)
(if (yes-or-no-p "Do you really want to unleash the powers of the butterfly? ")
(progn
@@ -137,7 +139,7 @@ variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'."
(sit-for (* 5 (/ (abs (random)) (float most-positive-fixnum))))
(message "Successfully flipped one bit!"))
(message "Well, then go to xkcd.com!")
- (browse-url "http://xkcd.com/378/")))
+ (browse-url "https://xkcd.com/378/")))
;; A command to list dynamically loaded libraries. This useful in
;; environments where dynamic-library-alist is used, i.e., Windows
@@ -162,7 +164,7 @@ Internal use only."
"Recompute the list of dynamic libraries.
Internal use only."
(setq tabulated-list-format ; recomputed because column widths can change
- (let ((max-id-len 0) (max-name-len 0))
+ (let ((max-id-len 7) (max-name-len 11))
(dolist (lib dynamic-library-alist)
(let ((id-len (length (symbol-name (car lib))))
(name-len (apply 'max (mapcar 'length (cdr lib)))))
@@ -181,7 +183,9 @@ Internal use only."
(push (list id (vector (symbol-name id)
(list-dynamic-libraries--loaded from)
(mapconcat 'identity (cdr lib) ", ")))
- tabulated-list-entries)))))
+ tabulated-list-entries))))
+ (when (not dynamic-library-alist)
+ (message "No dynamic libraries found")))
;;;###autoload
(defun list-dynamic-libraries (&optional loaded-only-p buffer)
diff --git a/lisp/misearch.el b/lisp/misearch.el
index 958c10a1bf6..6ec10fe2c2e 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -236,11 +236,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'."
(buf nil)
(ido-ignore-item-temp-list bufs))
(while (not (string-equal
- (setq buf (read-buffer
- (if (eq read-buffer-function #'ido-read-buffer)
- "Next buffer to search (C-j to end): "
- "Next buffer to search (RET to end): ")
- nil t))
+ (setq buf (read-buffer (multi-occur--prompt) nil t))
""))
(add-to-list 'bufs buf)
(setq ido-ignore-item-temp-list bufs))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index e58a2e6da18..9d4492f1bde 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -49,7 +49,10 @@
"If non-nil, copy to kill-ring upon mouse adjustments of the region.
This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in
-addition to mouse drags."
+addition to mouse drags.
+
+This variable applies only to mouse adjustments in Emacs, not
+selecting and adjusting regions in other windows."
:type 'boolean
:version "24.1")
@@ -271,34 +274,6 @@ not it is actually displayed."
local-menu
minor-mode-menus)))
-(defun mouse-major-mode-menu (event &optional prefix)
- "Pop up a mode-specific menu of mouse commands.
-Default to the Edit menu if the major mode doesn't define a menu."
- (declare (obsolete mouse-menu-major-mode-map "23.1"))
- (interactive "@e\nP")
- (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
- (popup-menu (mouse-menu-major-mode-map) event prefix))
-
-(defun mouse-popup-menubar (event prefix)
- "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX.
-The contents are the items that would be in the menu bar whether or
-not it is actually displayed."
- (declare (obsolete mouse-menu-bar-map "23.1"))
- (interactive "@e \nP")
- (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
- (popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix))
-
-(defun mouse-popup-menubar-stuff (event prefix)
- "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'.
-Use the former if the menu bar is showing, otherwise the latter."
- (declare (obsolete nil "23.1"))
- (interactive "@e\nP")
- (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
- (popup-menu
- (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
- (mouse-menu-bar-map)
- (mouse-menu-major-mode-map))
- event prefix))
;; Commands that operate on windows.
@@ -552,7 +527,7 @@ frame instead."
(not (eq (window-frame minibuffer-window) frame))))
;; Drag frame when the window is on the bottom of its frame and
;; there is no minibuffer window below.
- (mouse-drag-frame start-event 'move)))))
+ (mouse-drag-frame-move start-event)))))
(defun mouse-drag-header-line (start-event)
"Change the height of a window by dragging on its header line.
@@ -569,7 +544,7 @@ the frame instead."
(mouse-drag-line start-event 'header)
(let ((frame (window-frame window)))
(when (frame-parameter frame 'drag-with-header-line)
- (mouse-drag-frame start-event 'move))))))
+ (mouse-drag-frame-move start-event))))))
(defun mouse-drag-vertical-line (start-event)
"Change the width of a window by dragging on a vertical line.
@@ -577,46 +552,137 @@ START-EVENT is the starting mouse event of the drag action."
(interactive "e")
(mouse-drag-line start-event 'vertical))
-(defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move)
- "Helper function for `mouse-drag-frame'."
- (let* ((frame-x-y (frame-position frame))
- (frame-x (car frame-x-y))
- (frame-y (cdr frame-x-y))
- alist)
- (if (> x-diff 0)
- (when x-move
- (setq x-diff (min x-diff frame-x))
- (setq x-move (- frame-x x-diff)))
- (let* ((min-width (frame-windows-min-size frame t nil t))
- (min-diff (max 0 (- (frame-inner-width frame) min-width))))
- (setq x-diff (max x-diff (- min-diff)))
- (when x-move
- (setq x-move (+ frame-x (- x-diff))))))
-
- (if (> y-diff 0)
- (when y-move
- (setq y-diff (min y-diff frame-y))
- (setq y-move (- frame-y y-diff)))
- (let* ((min-height (frame-windows-min-size frame nil nil t))
- (min-diff (max 0 (- (frame-inner-height frame) min-height))))
- (setq y-diff (max y-diff (- min-diff)))
- (when y-move
- (setq y-move (+ frame-y (- y-diff))))))
-
- (unless (zerop x-diff)
- (when x-move
- (push `(left . ,x-move) alist))
- (push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff)))
- alist))
- (unless (zerop y-diff)
- (when y-move
- (push `(top . ,y-move) alist))
- (push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff)))
- alist))
- (when alist
- (modify-frame-parameters frame alist))))
-
-(defun mouse-drag-frame (start-event part)
+(defun mouse-drag-frame-resize (start-event part)
+ "Drag a frame or one of its edges with the mouse.
+START-EVENT is the starting mouse event of the drag action. Its
+position window denotes the frame that will be dragged.
+
+PART specifies the part that has been dragged and must be one of
+the symbols `left', `top', `right', `bottom', `top-left',
+`top-right', `bottom-left', `bottom-right' to drag an internal
+border or edge. If PART equals `move', this means to move the
+frame with the mouse."
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (let* ((echo-keystrokes 0)
+ (start (event-start start-event))
+ (window (posn-window start))
+ ;; FRAME is the frame to drag.
+ (frame (if (window-live-p window)
+ (window-frame window)
+ window))
+ ;; Initial "first" frame position and size. While dragging we
+ ;; base all calculations against that size and position.
+ (first-pos (frame-position frame))
+ (first-left (car first-pos))
+ (first-top (cdr first-pos))
+ (first-width (frame-text-width frame))
+ (first-height (frame-text-height frame))
+ ;; Don't let FRAME become less large than the size needed to
+ ;; fit all of its windows.
+ (min-text-width
+ (+ (frame-windows-min-size frame t nil t)
+ (- (frame-inner-width frame) first-width)))
+ (min-text-height
+ (+ (frame-windows-min-size frame nil nil t)
+ (- (frame-inner-height frame) first-height)))
+ ;; PARENT is the parent frame of FRAME or, if FRAME is a
+ ;; top-level frame, FRAME's workarea.
+ (parent (frame-parent frame))
+ (parent-edges
+ (if parent
+ (frame-edges parent)
+ (let* ((attributes
+ (car (display-monitor-attributes-list)))
+ (workarea (assq 'workarea attributes)))
+ (and workarea
+ `(,(nth 1 workarea) ,(nth 2 workarea)
+ ,(+ (nth 1 workarea) (nth 3 workarea))
+ ,(+ (nth 2 workarea) (nth 4 workarea)))))))
+ (parent-left (and parent-edges (nth 0 parent-edges)))
+ (parent-top (and parent-edges (nth 1 parent-edges)))
+ (parent-right (and parent-edges (nth 2 parent-edges)))
+ (parent-bottom (and parent-edges (nth 3 parent-edges)))
+ ;; Drag types. drag-left/drag-right and drag-top/drag-bottom
+ ;; are mutually exclusive.
+ (drag-left (memq part '(bottom-left left top-left)))
+ (drag-top (memq part '(top-left top top-right)))
+ (drag-right (memq part '(top-right right bottom-right)))
+ (drag-bottom (memq part '(bottom-right bottom bottom-left)))
+ ;; Initial "first" mouse position. While dragging we base all
+ ;; calculations against that position.
+ (first-x-y (mouse-absolute-pixel-position))
+ (first-x (car first-x-y))
+ (first-y (cdr first-x-y))
+ (exitfun nil)
+ (move
+ (lambda (event)
+ (interactive "e")
+ (when (consp event)
+ (let* ((last-x-y (mouse-absolute-pixel-position))
+ (last-x (car last-x-y))
+ (last-y (cdr last-x-y))
+ (left (- last-x first-x))
+ (top (- last-y first-y))
+ alist)
+ ;; We never want to warp the mouse position here. When
+ ;; moving the mouse leftward or upward, then with a wide
+ ;; border the calculated left or top position of the
+ ;; frame could drop to a value less than zero depending
+ ;; on where precisely the mouse within the border. We
+ ;; guard against this by never allowing the frame to
+ ;; move to a position less than zero here. No such
+ ;; precautions are used for the right and bottom borders
+ ;; so with a large internal border parts of that border
+ ;; may disappear.
+ (when (and drag-left (>= last-x parent-left)
+ (>= (- first-width left) min-text-width))
+ (push `(left . ,(max (+ first-left left) 0)) alist)
+ (push `(width . (text-pixels . ,(- first-width left)))
+ alist))
+ (when (and drag-top (>= last-y parent-top)
+ (>= (- first-height top) min-text-height))
+ (push `(top . ,(max 0 (+ first-top top))) alist)
+ (push `(height . (text-pixels . ,(- first-height top)))
+ alist))
+ (when (and drag-right (<= last-x parent-right)
+ (>= (+ first-width left) min-text-width))
+ (push `(width . (text-pixels . ,(+ first-width left)))
+ alist))
+ (when (and drag-bottom (<= last-y parent-bottom)
+ (>= (+ first-height top) min-text-height))
+ (push `(height . (text-pixels . ,(+ first-height top)))
+ alist))
+ (modify-frame-parameters frame alist)))))
+ (old-track-mouse track-mouse))
+ ;; Start tracking. The special value 'dragging' signals the
+ ;; display engine to freeze the mouse pointer shape for as long
+ ;; as we drag.
+ (setq track-mouse 'dragging)
+ ;; Loop reading events and sampling the position of the mouse.
+ (setq exitfun
+ (set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [switch-frame] #'ignore)
+ (define-key map [select-window] #'ignore)
+ (define-key map [scroll-bar-movement] #'ignore)
+ (define-key map [mouse-movement] move)
+ ;; Swallow drag-mouse-1 events to avoid selecting some other window.
+ (define-key map [drag-mouse-1]
+ (lambda () (interactive) (funcall exitfun)))
+ ;; Some of the events will of course end up looked up
+ ;; with a mode-line, header-line or vertical-line prefix ...
+ (define-key map [mode-line] map)
+ (define-key map [header-line] map)
+ (define-key map [vertical-line] map)
+ ;; ... and some maybe even with a right- or bottom-divider
+ ;; prefix.
+ (define-key map [right-divider] map)
+ (define-key map [bottom-divider] map)
+ map)
+ t (lambda () (setq track-mouse old-track-mouse))))))
+
+(defun mouse-drag-frame-move (start-event)
"Drag a frame or one of its edges with the mouse.
START-EVENT is the starting mouse event of the drag action. Its
position window denotes the frame that will be dragged.
@@ -635,9 +701,14 @@ frame with the mouse."
(frame (if (window-live-p window)
(window-frame window)
window))
- (width (frame-native-width frame))
- (height (frame-native-height frame))
- ;; PARENT is the parent frame of FRAME or, if FRAME is a
+ (native-width (frame-native-width frame))
+ (native-height (frame-native-height frame))
+ ;; Initial "first" frame position and size. While dragging we
+ ;; base all calculations against that size and position.
+ (first-pos (frame-position frame))
+ (first-left (car first-pos))
+ (first-top (cdr first-pos))
+ ;; PARENT is the parent frame of FRAME or, if FRAME is a
;; top-level frame, FRAME's workarea.
(parent (frame-parent frame))
(parent-edges
@@ -654,19 +725,16 @@ frame with the mouse."
(parent-top (and parent-edges (nth 1 parent-edges)))
(parent-right (and parent-edges (nth 2 parent-edges)))
(parent-bottom (and parent-edges (nth 3 parent-edges)))
- ;; `pos-x' and `pos-y' record the x- and y-coordinates of the
- ;; last sampled mouse position. Note that we sample absolute
- ;; mouse positions to avoid that moving the mouse from one
- ;; frame into another gets into our way. `last-x' and `last-y'
- ;; records the x- and y-coordinates of the previously sampled
- ;; position. The differences between `last-x' and `pos-x' as
- ;; well as `last-y' and `pos-y' determine the amount the mouse
- ;; has been dragged between the last two samples.
- pos-x-y pos-x pos-y
- (last-x-y (mouse-absolute-pixel-position))
- (last-x (car last-x-y))
- (last-y (cdr last-x-y))
- ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
+ ;; Initial "first" mouse position. While dragging we base all
+ ;; calculations against that position.
+ (first-x-y (mouse-absolute-pixel-position))
+ (first-x (car first-x-y))
+ (first-y (cdr first-x-y))
+ ;; `snap-width' (maybe also a yet to be provided `snap-height')
+ ;; could become floats to handle proportionality wrt PARENT.
+ ;; We don't do any checks on this parameter so far.
+ (snap-width (frame-parameter frame 'snap-width))
+ ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
;; mouse position when FRAME snapped. As soon as the
;; difference between `pos-x' and `snap-x' (or `pos-y' and
;; `snap-y') exceeds the value of FRAME's `snap-width'
@@ -678,176 +746,141 @@ frame with the mouse."
(lambda (event)
(interactive "e")
(when (consp event)
- (setq pos-x-y (mouse-absolute-pixel-position))
- (setq pos-x (car pos-x-y))
- (setq pos-y (cdr pos-x-y))
- (cond
- ((eq part 'left)
- (mouse-resize-frame frame (- last-x pos-x) 0 t))
- ((eq part 'top)
- (mouse-resize-frame frame 0 (- last-y pos-y) nil t))
- ((eq part 'right)
- (mouse-resize-frame frame (- pos-x last-x) 0))
- ((eq part 'bottom)
- (mouse-resize-frame frame 0 (- pos-y last-y)))
- ((eq part 'top-left)
- (mouse-resize-frame
- frame (- last-x pos-x) (- last-y pos-y) t t))
- ((eq part 'top-right)
- (mouse-resize-frame
- frame (- pos-x last-x) (- last-y pos-y) nil t))
- ((eq part 'bottom-left)
- (mouse-resize-frame
- frame (- last-x pos-x) (- pos-y last-y) t))
- ((eq part 'bottom-right)
- (mouse-resize-frame
- frame (- pos-x last-x) (- pos-y last-y)))
- ((eq part 'move)
- (let* ((old-position (frame-position frame))
- (old-left (car old-position))
- (old-top (cdr old-position))
- (left (+ old-left (- pos-x last-x)))
- (top (+ old-top (- pos-y last-y)))
- right bottom
- ;; `snap-width' (maybe also a yet to be provided
- ;; `snap-height') could become floats to handle
- ;; proportionality wrt PARENT. We don't do any
- ;; checks on this parameter so far.
- (snap-width (frame-parameter frame 'snap-width)))
- ;; Docking and constraining.
- (when (and (numberp snap-width) parent-edges)
+ (let* ((last-x-y (mouse-absolute-pixel-position))
+ (last-x (car last-x-y))
+ (last-y (cdr last-x-y))
+ (left (- last-x first-x))
+ (top (- last-y first-y))
+ right bottom)
+ (setq left (+ first-left left))
+ (setq top (+ first-top top))
+ ;; Docking and constraining.
+ (when (and (numberp snap-width) parent-edges)
+ (cond
+ ;; Docking at the left parent edge.
+ ((< last-x first-x)
(cond
- ;; Docking at the left parent edge.
- ((< pos-x last-x)
- (cond
- ((and (> left parent-left)
- (<= (- left parent-left) snap-width))
- ;; Snap when the mouse moved leftward and
- ;; FRAME's left edge would end up within
- ;; `snap-width' pixels from PARENT's left edge.
- (setq snap-x pos-x)
- (setq left parent-left))
- ((and (<= left parent-left)
- (<= (- parent-left left) snap-width)
- snap-x (<= (- snap-x pos-x) snap-width))
- ;; Stay snapped when the mouse moved leftward
- ;; but not more than `snap-width' pixels from
- ;; the time FRAME snapped.
- (setq left parent-left))
- (t
- ;; Unsnap when the mouse moved more than
- ;; `snap-width' pixels leftward from the time
- ;; FRAME snapped.
- (setq snap-x nil))))
- ((> pos-x last-x)
- (setq right (+ left width))
- (cond
- ((and (< right parent-right)
- (<= (- parent-right right) snap-width))
- ;; Snap when the mouse moved rightward and
- ;; FRAME's right edge would end up within
- ;; `snap-width' pixels from PARENT's right edge.
- (setq snap-x pos-x)
- (setq left (- parent-right width)))
- ((and (>= right parent-right)
- (<= (- right parent-right) snap-width)
- snap-x (<= (- pos-x snap-x) snap-width))
- ;; Stay snapped when the mouse moved rightward
- ;; but not more more than `snap-width' pixels
- ;; from the time FRAME snapped.
- (setq left (- parent-right width)))
- (t
- ;; Unsnap when the mouse moved rightward more
- ;; than `snap-width' pixels from the time FRAME
- ;; snapped.
- (setq snap-x nil)))))
-
+ ((and (> left parent-left)
+ (<= (- left parent-left) snap-width))
+ ;; Snap when the mouse moved leftward and FRAME's
+ ;; left edge would end up within `snap-width'
+ ;; pixels from PARENT's left edge.
+ (setq snap-x last-x)
+ (setq left parent-left))
+ ((and (<= left parent-left)
+ (<= (- parent-left left) snap-width)
+ snap-x (<= (- snap-x last-x) snap-width))
+ ;; Stay snapped when the mouse moved leftward but
+ ;; not more than `snap-width' pixels from the time
+ ;; FRAME snapped.
+ (setq left parent-left))
+ (t
+ ;; Unsnap when the mouse moved more than
+ ;; `snap-width' pixels leftward from the time
+ ;; FRAME snapped.
+ (setq snap-x nil))))
+ ((> last-x first-x)
+ (setq right (+ left native-width))
(cond
- ((< pos-y last-y)
- (cond
- ((and (> top parent-top)
- (<= (- top parent-top) snap-width))
- ;; Snap when the mouse moved upward and FRAME's
- ;; top edge would end up within `snap-width'
- ;; pixels from PARENT's top edge.
- (setq snap-y pos-y)
- (setq top parent-top))
- ((and (<= top parent-top)
- (<= (- parent-top top) snap-width)
- snap-y (<= (- snap-y pos-y) snap-width))
- ;; Stay snapped when the mouse moved upward but
- ;; not more more than `snap-width' pixels from
- ;; the time FRAME snapped.
- (setq top parent-top))
- (t
- ;; Unsnap when the mouse moved upward more than
- ;; `snap-width' pixels from the time FRAME
- ;; snapped.
- (setq snap-y nil))))
- ((> pos-y last-y)
- (setq bottom (+ top height))
- (cond
- ((and (< bottom parent-bottom)
- (<= (- parent-bottom bottom) snap-width))
- ;; Snap when the mouse moved downward and
- ;; FRAME's bottom edge would end up within
- ;; `snap-width' pixels from PARENT's bottom
- ;; edge.
- (setq snap-y pos-y)
- (setq top (- parent-bottom height)))
- ((and (>= bottom parent-bottom)
- (<= (- bottom parent-bottom) snap-width)
- snap-y (<= (- pos-y snap-y) snap-width))
- ;; Stay snapped when the mouse moved downward
- ;; but not more more than `snap-width' pixels
- ;; from the time FRAME snapped.
- (setq top (- parent-bottom height)))
- (t
- ;; Unsnap when the mouse moved downward more
- ;; than `snap-width' pixels from the time FRAME
- ;; snapped.
- (setq snap-y nil))))))
-
- ;; If requested, constrain FRAME's draggable areas to
- ;; PARENT's edges. The `top-visible' parameter should
- ;; be set when FRAME has a draggable header-line. If
- ;; set to a number, it ascertains that the top of
- ;; FRAME is always constrained to the top of PARENT
- ;; and that at least as many pixels of FRAME as
- ;; specified by that number are visible on each of the
- ;; three remaining sides of PARENT.
- ;;
- ;; The `bottom-visible' parameter should be set when
- ;; FRAME has a draggable mode-line. If set to a
- ;; number, it ascertains that the bottom of FRAME is
- ;; always constrained to the bottom of PARENT and that
- ;; at least as many pixels of FRAME as specified by
- ;; that number are visible on each of the three
- ;; remaining sides of PARENT.
- (let ((par (frame-parameter frame 'top-visible))
- bottom-visible)
- (unless par
- (setq par (frame-parameter frame 'bottom-visible))
- (setq bottom-visible t))
- (when (and (numberp par) parent-edges)
- (setq left
- (max (min (- parent-right par) left)
- (+ (- parent-left width) par)))
- (setq top
- (if bottom-visible
- (min (max top (- parent-top (- height par)))
- (- parent-bottom height))
- (min (max top parent-top)
- (- parent-bottom par))))))
-
- ;; Use `modify-frame-parameters' since `left' and
- ;; `top' may want to move FRAME out of its PARENT.
- (modify-frame-parameters
- frame
- `((left . (+ ,left)) (top . (+ ,top)))))))
- (setq last-x pos-x)
- (setq last-y pos-y))))
- (old-track-mouse track-mouse))
+ ((and (< right parent-right)
+ (<= (- parent-right right) snap-width))
+ ;; Snap when the mouse moved rightward and FRAME's
+ ;; right edge would end up within `snap-width'
+ ;; pixels from PARENT's right edge.
+ (setq snap-x last-x)
+ (setq left (- parent-right native-width)))
+ ((and (>= right parent-right)
+ (<= (- right parent-right) snap-width)
+ snap-x (<= (- last-x snap-x) snap-width))
+ ;; Stay snapped when the mouse moved rightward but
+ ;; not more more than `snap-width' pixels from the
+ ;; time FRAME snapped.
+ (setq left (- parent-right native-width)))
+ (t
+ ;; Unsnap when the mouse moved rightward more than
+ ;; `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-x nil)))))
+ (cond
+ ((< last-y first-y)
+ (cond
+ ((and (> top parent-top)
+ (<= (- top parent-top) snap-width))
+ ;; Snap when the mouse moved upward and FRAME's
+ ;; top edge would end up within `snap-width'
+ ;; pixels from PARENT's top edge.
+ (setq snap-y last-y)
+ (setq top parent-top))
+ ((and (<= top parent-top)
+ (<= (- parent-top top) snap-width)
+ snap-y (<= (- snap-y last-y) snap-width))
+ ;; Stay snapped when the mouse moved upward but
+ ;; not more more than `snap-width' pixels from the
+ ;; time FRAME snapped.
+ (setq top parent-top))
+ (t
+ ;; Unsnap when the mouse moved upward more than
+ ;; `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-y nil))))
+ ((> last-y first-y)
+ (setq bottom (+ top native-height))
+ (cond
+ ((and (< bottom parent-bottom)
+ (<= (- parent-bottom bottom) snap-width))
+ ;; Snap when the mouse moved downward and FRAME's
+ ;; bottom edge would end up within `snap-width'
+ ;; pixels from PARENT's bottom edge.
+ (setq snap-y last-y)
+ (setq top (- parent-bottom native-height)))
+ ((and (>= bottom parent-bottom)
+ (<= (- bottom parent-bottom) snap-width)
+ snap-y (<= (- last-y snap-y) snap-width))
+ ;; Stay snapped when the mouse moved downward but
+ ;; not more more than `snap-width' pixels from the
+ ;; time FRAME snapped.
+ (setq top (- parent-bottom native-height)))
+ (t
+ ;; Unsnap when the mouse moved downward more than
+ ;; `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-y nil))))))
+
+ ;; If requested, constrain FRAME's draggable areas to
+ ;; PARENT's edges. The `top-visible' parameter should
+ ;; be set when FRAME has a draggable header-line. If
+ ;; set to a number, it ascertains that the top of FRAME
+ ;; is always constrained to the top of PARENT and that
+ ;; at least as many pixels of FRAME as specified by that
+ ;; number are visible on each of the three remaining
+ ;; sides of PARENT.
+ ;;
+ ;; The `bottom-visible' parameter should be set when
+ ;; FRAME has a draggable mode-line. If set to a number,
+ ;; it ascertains that the bottom of FRAME is always
+ ;; constrained to the bottom of PARENT and that at least
+ ;; as many pixels of FRAME as specified by that number
+ ;; are visible on each of the three remaining sides of
+ ;; PARENT.
+ (let ((par (frame-parameter frame 'top-visible))
+ bottom-visible)
+ (unless par
+ (setq par (frame-parameter frame 'bottom-visible))
+ (setq bottom-visible t))
+ (when (and (numberp par) parent-edges)
+ (setq left
+ (max (min (- parent-right par) left)
+ (+ (- parent-left native-width) par)))
+ (setq top
+ (if bottom-visible
+ (min (max top (- parent-top (- native-height par)))
+ (- parent-bottom native-height))
+ (min (max top parent-top)
+ (- parent-bottom par))))))
+ ;; Use `modify-frame-parameters' since `left' and `top'
+ ;; may want to move FRAME out of its PARENT.
+ (modify-frame-parameters frame `((left . (+ ,left)) (top . (+ ,top))))))))
+ (old-track-mouse track-mouse))
;; Start tracking. The special value 'dragging' signals the
;; display engine to freeze the mouse pointer shape for as long
;; as we drag.
@@ -879,49 +912,49 @@ frame with the mouse."
"Drag left edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'left))
+ (mouse-drag-frame-resize start-event 'left))
(defun mouse-drag-top-left-corner (start-event)
"Drag top left corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'top-left))
+ (mouse-drag-frame-resize start-event 'top-left))
(defun mouse-drag-top-edge (start-event)
"Drag top edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'top))
+ (mouse-drag-frame-resize start-event 'top))
(defun mouse-drag-top-right-corner (start-event)
"Drag top right corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'top-right))
+ (mouse-drag-frame-resize start-event 'top-right))
(defun mouse-drag-right-edge (start-event)
"Drag right edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'right))
+ (mouse-drag-frame-resize start-event 'right))
(defun mouse-drag-bottom-right-corner (start-event)
"Drag bottom right corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'bottom-right))
+ (mouse-drag-frame-resize start-event 'bottom-right))
(defun mouse-drag-bottom-edge (start-event)
"Drag bottom edge of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'bottom))
+ (mouse-drag-frame-resize start-event 'bottom))
(defun mouse-drag-bottom-left-corner (start-event)
"Drag bottom left corner of a frame with the mouse.
START-EVENT is the starting mouse event of the drag action."
(interactive "e")
- (mouse-drag-frame start-event 'bottom-left))
+ (mouse-drag-frame-resize start-event 'bottom-left))
(defcustom mouse-select-region-move-to-beginning nil
"Effect of selecting a region extending backward from double click.
@@ -2173,8 +2206,8 @@ and selects that window."
;; Sort the list to put the most popular major modes first.
(setq split-by-major-mode
(sort split-by-major-mode
- (function (lambda (elt1 elt2)
- (> (length elt1) (length elt2))))))
+ (lambda (elt1 elt2)
+ (> (length elt1) (length elt2)))))
;; Make a separate submenu for each major mode
;; that has more than one buffer,
;; unless all the remaining buffers are less than 1/10 of them.
@@ -2215,8 +2248,8 @@ and selects that window."
head)
(setq buffers
(sort buffers
- (function (lambda (elt1 elt2)
- (string< (buffer-name elt1) (buffer-name elt2))))))
+ (lambda (elt1 elt2)
+ (string< (buffer-name elt1) (buffer-name elt2)))))
(setq tail buffers)
(while tail
(or (eq ?\s (aref (buffer-name (car tail)) 0))
@@ -2270,9 +2303,6 @@ and selects that window."
;; Few buffers--put them all in one pane.
(list (cons title alist))))
-(define-obsolete-function-alias
- 'mouse-choose-completion 'choose-completion "23.2")
-
;; Font selection.
(defun font-menu-add-default ()
@@ -2498,7 +2528,7 @@ region, text is copied instead of being cut."
(lambda (modifier)
`(const :tag ,(format "Enable, but copy with the %s modifier"
modifier)
- modifier))
+ ,modifier))
'(alt super hyper shift control meta))
(other :tag "Enable dragging the region" t))
:version "26.1")
@@ -2517,9 +2547,12 @@ as it does when dropping text in the source buffer."
If this option is nil, `mouse-drag-and-drop-region' does not show
tooltips. If this is t, it shows the entire text dragged in a
tooltip. If this is an integer (as with the default value of
-256), it will show that many characters of the dragged text in
-a tooltip."
- :type 'integer
+256), it will show up to that many characters of the dragged text
+in a tooltip."
+ :type '(choice
+ (const :tag "Do not show tooltips" nil)
+ (const :tag "Show all text" t)
+ (integer :tag "Max number of characters to show" 256))
:version "26.1")
(defcustom mouse-drag-and-drop-region-show-cursor t
@@ -2553,6 +2586,7 @@ is copied instead of being cut."
(let* ((mouse-button (event-basic-type last-input-event))
(mouse-drag-and-drop-region-show-tooltip
(when (and mouse-drag-and-drop-region-show-tooltip
+ (> mouse-drag-and-drop-region-show-tooltip 0)
(display-multi-frame-p)
(require 'tooltip))
mouse-drag-and-drop-region-show-tooltip))
@@ -2588,7 +2622,7 @@ is copied instead of being cut."
;; this for all windows on all visible frames. In addition we save
;; also the cursor type for the window's buffer so we can restore it
;; in case we modified it.
- ;; https://lists.gnu.org/archive/html/emacs-devel/2017-12/msg00090.html
+ ;; https://lists.gnu.org/r/emacs-devel/2017-12/msg00090.html
(walk-window-tree
(lambda (window)
(setq states
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 47fe4dea7fa..fade23e3cc2 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -819,8 +819,8 @@ The songs are returned as alists."
(defun mpc-cmd-status ()
(mpc-proc-cmd-to-alist "status"))
-(defun mpc-cmd-play ()
- (mpc-proc-cmd "play")
+(defun mpc-cmd-play (&optional sn)
+ (mpc-proc-cmd (if sn (list "play" sn) "play"))
(mpc-status-refresh))
(defun mpc-cmd-seekcur (time)
@@ -849,7 +849,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;; Sort them from last to first, so the renumbering
;; caused by the earlier deletions don't affect
;; later ones.
- (sort song-poss '>))))
+ (sort (copy-sequence song-poss) '>))))
(if (stringp playlist)
(puthash (cons 'Playlist playlist) nil mpc--find-memoize)))
@@ -873,7 +873,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;; Sort them from last to first, so the renumbering
;; caused by the earlier deletions affect
;; later ones a bit less.
- (sort song-poss '>))))
+ (sort (copy-sequence song-poss) '>))))
(if (stringp playlist)
(puthash (cons 'Playlist playlist) nil mpc--find-memoize))))
@@ -2089,7 +2089,7 @@ This is used so that they can be compared with `eq', which is needed for
((null (with-current-buffer plbuf (re-search-forward re nil t)))
;; song-file only appears once in the playlist: no ambiguity,
;; we're good to go!
- (mpc-proc-cmd (list "play" sn)))
+ (mpc-cmd-play sn))
(t
;; The song appears multiple times in the playlist. If the current
;; buffer holds not only the destination song but also the current
@@ -2391,6 +2391,7 @@ This is used so that they can be compared with `eq', which is needed for
(interactive)
(mpc-cmd-stop)
(mpc-cmd-clear)
+ (mpc-songs-refresh)
(mpc-status-refresh))
(defun mpc-pause ()
@@ -2750,7 +2751,9 @@ If stopped, start playback."
(if current-prefix-arg
;; FIXME: We should provide some completion here, especially for the
;; case where the user specifies a local socket/file name.
- (setq mpc-host (read-string "MPD host and port: " nil nil mpc-host)))
+ (setq mpc-host (read-string
+ (format-prompt "MPD host and port" mpc-host)
+ nil nil mpc-host)))
nil))
(let* ((song-buf (mpc-songs-buf))
(song-win (get-buffer-window song-buf 0)))
diff --git a/lisp/msb.el b/lisp/msb.el
index ebaf98cbe83..15aeaa2e73f 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -372,6 +372,8 @@ This is instead of the groups in `msb-menu-cond'."
:type 'hook
:set 'msb-custom-set
:group 'msb)
+(make-obsolete-variable 'msb-after-load-hook
+ "use `with-eval-after-load' instead." "28.1")
;;;
;;; Internal variables
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 317f2cd8edd..1d9fe68075b 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -1,4 +1,4 @@
-;;; mwheel.el --- Wheel mouse support
+;;; mwheel.el --- Mouse wheel support -*- lexical-binding:t -*-
;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
;; Keywords: mouse
@@ -25,8 +25,8 @@
;; Under X11/X.Org, the wheel events are sent as button4/button5
;; events.
-;; It is already enabled by default on most graphical displays. You
-;; can toggle it with M-x mouse-wheel-mode.
+;; Mouse wheel support is already enabled by default on most graphical
+;; displays. You can toggle it using `M-x mouse-wheel-mode'.
;;; Code:
@@ -85,7 +85,7 @@ set to the event sent when clicking on the mouse wheel button."
:type 'number)
(defcustom mouse-wheel-scroll-amount
- '(5 ((shift) . 1) ((meta) . nil) ((control) . text-scale))
+ '(1 ((shift) . hscroll) ((meta) . nil) ((control) . text-scale))
"Amount to scroll windows by when spinning the mouse wheel.
This is an alist mapping the modifier key to the amount to scroll when
the wheel is moved with the modifier key depressed.
@@ -97,6 +97,9 @@ screen. It can also be a floating point number, specifying the fraction of
a full screen to scroll. A near full screen is `next-screen-context-lines'
less than a full screen.
+If AMOUNT is the symbol 'hscroll', this means that with MODIFIER,
+the mouse wheel will scroll horizontally instead of vertically.
+
If AMOUNT is the symbol text-scale, this means that with
MODIFIER, the mouse wheel will change the face height instead of
scrolling."
@@ -123,9 +126,10 @@ scrolling."
(const :tag "Scroll full screen" :value nil)
(integer :tag "Scroll specific # of lines")
(float :tag "Scroll fraction of window")
+ (const :tag "Scroll horizontally" :value hscroll)
(const :tag "Change face size" :value text-scale)))))
:set 'mouse-wheel-change-button
- :version "27.1")
+ :version "28.1")
(defcustom mouse-wheel-progressive-speed t
"If non-nil, the faster the user moves the wheel, the faster the scrolling.
@@ -142,6 +146,16 @@ face height."
:group 'mouse
:type 'boolean)
+(defcustom mouse-wheel-scroll-amount-horizontal 1
+ "Amount to scroll windows horizontally.
+Its value can be changed dynamically by using a numeric prefix argument
+before starting horizontal scrolling.
+It has effect when `mouse-wheel-scroll-amount' binds the value `hscroll'
+to one of modifiers (`Shift' by default)."
+ :group 'mouse
+ :type 'number
+ :version "28.1")
+
;;; For tilt-scroll
;;;
(defcustom mouse-wheel-tilt-scroll nil
@@ -162,23 +176,18 @@ Also see `mouse-wheel-tilt-scroll'."
:type 'boolean
:version "26.1")
-(eval-and-compile
- (if (fboundp 'event-button)
- (fset 'mwheel-event-button 'event-button)
- (defun mwheel-event-button (event)
- (let ((x (event-basic-type event)))
- ;; Map mouse-wheel events to appropriate buttons
- (if (eq 'mouse-wheel x)
- (let ((amount (car (cdr (cdr (cdr event))))))
- (if (< amount 0)
- mouse-wheel-up-event
- mouse-wheel-down-event))
- x))))
-
- (if (fboundp 'event-window)
- (fset 'mwheel-event-window 'event-window)
- (defun mwheel-event-window (event)
- (posn-window (event-start event)))))
+(defun mwheel-event-button (event)
+ (let ((x (event-basic-type event)))
+ ;; Map mouse-wheel events to appropriate buttons
+ (if (eq 'mouse-wheel x)
+ (let ((amount (car (cdr (cdr (cdr event))))))
+ (if (< amount 0)
+ mouse-wheel-up-event
+ mouse-wheel-down-event))
+ x)))
+
+(defun mwheel-event-window (event)
+ (posn-window (event-start event)))
(defvar mwheel-inhibit-click-event-timer nil
"Timer running while mouse wheel click event is inhibited.")
@@ -208,13 +217,13 @@ Also see `mouse-wheel-tilt-scroll'."
(defvar mouse-wheel-left-event
(if (or (featurep 'w32-win) (featurep 'ns-win))
'wheel-left
- (intern "mouse-6"))
+ 'mouse-6)
"Event used for scrolling left.")
(defvar mouse-wheel-right-event
(if (or (featurep 'w32-win) (featurep 'ns-win))
'wheel-right
- (intern "mouse-7"))
+ 'mouse-7)
"Event used for scrolling right.")
(defun mouse-wheel--get-scroll-window (event)
@@ -244,11 +253,17 @@ active window."
frame nil t)))))
(mwheel-event-window event)))
-(defun mwheel-scroll (event)
+(defun mwheel-scroll (event &optional arg)
"Scroll up or down according to the EVENT.
This should be bound only to mouse buttons 4, 5, 6, and 7 on
-non-Windows systems."
- (interactive (list last-input-event))
+non-Windows systems.
+
+Optional argument ARG (interactively, prefix numeric argument) controls
+the step of horizontal scrolling.
+
+The variable `mouse-wheel-scroll-amount-horizontal' records the last
+value of ARG, and the command uses it in subsequent scrolls."
+ (interactive (list last-input-event current-prefix-arg))
(let* ((selected-window (selected-window))
(scroll-window (mouse-wheel--get-scroll-window event))
(old-point
@@ -275,7 +290,14 @@ non-Windows systems."
(condition-case nil
(unwind-protect
(let ((button (mwheel-event-button event)))
- (cond ((eq button mouse-wheel-down-event)
+ (cond ((and (eq amt 'hscroll) (eq button mouse-wheel-down-event))
+ (when (and (natnump arg) (> arg 0))
+ (setq mouse-wheel-scroll-amount-horizontal arg))
+ (funcall (if mouse-wheel-flip-direction
+ mwheel-scroll-left-function
+ mwheel-scroll-right-function)
+ mouse-wheel-scroll-amount-horizontal))
+ ((eq button mouse-wheel-down-event)
(condition-case nil (funcall mwheel-scroll-down-function amt)
;; Make sure we do indeed scroll to the beginning of
;; the buffer.
@@ -290,7 +312,14 @@ non-Windows systems."
;; for a reason that escapes me. This problem seems
;; to only affect scroll-down. --Stef
(set-window-start (selected-window) (point-min))))))
- ((eq button mouse-wheel-up-event)
+ ((and (eq amt 'hscroll) (eq button mouse-wheel-up-event))
+ (when (and (natnump arg) (> arg 0))
+ (setq mouse-wheel-scroll-amount-horizontal arg))
+ (funcall (if mouse-wheel-flip-direction
+ mwheel-scroll-right-function
+ mwheel-scroll-left-function)
+ mouse-wheel-scroll-amount-horizontal))
+ ((eq button mouse-wheel-up-event)
(condition-case nil (funcall mwheel-scroll-up-function amt)
;; Make sure we do indeed scroll to the end of the buffer.
(end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
@@ -349,16 +378,39 @@ non-Windows systems."
(text-scale-decrease 1)))
(select-window selected-window))))
-(defvar mwheel-installed-bindings nil)
-(defvar mwheel-installed-text-scale-bindings nil)
+(defvar mouse-wheel--installed-bindings-alist nil
+ "Alist of all installed mouse wheel key bindings.")
+
+(defun mouse-wheel--add-binding (key fun)
+ "Bind mouse wheel button KEY to function FUN.
+Save it for later removal by `mouse-wheel--remove-bindings'."
+ (global-set-key key fun)
+ (push (cons key fun) mouse-wheel--installed-bindings-alist))
-(defun mouse-wheel--remove-bindings (bindings funs)
- "Remove key BINDINGS if they're bound to any function in FUNS.
-BINDINGS is a list of key bindings, FUNS is a list of functions.
+(defun mouse-wheel--remove-bindings ()
+ "Remove all mouse wheel key bindings.
This is a helper function for `mouse-wheel-mode'."
- (dolist (key bindings)
- (when (memq (lookup-key (current-global-map) key) funs)
- (global-unset-key key))))
+ (dolist (binding mouse-wheel--installed-bindings-alist)
+ (let ((key (car binding))
+ (fun (cdr binding)))
+ (when (eq (lookup-key (current-global-map) key) fun)
+ (global-unset-key key))))
+ (setq mouse-wheel--installed-bindings-alist nil))
+
+(defun mouse-wheel--create-scroll-keys (binding event)
+ "Return list of key vectors for BINDING and EVENT.
+BINDING is an element in `mouse-wheel-scroll-amount'. EVENT is
+an event used for scrolling, such as `mouse-wheel-down-event'."
+ (let ((prefixes (list 'left-margin 'right-margin
+ 'left-fringe 'right-fringe
+ 'vertical-scroll-bar 'horizontal-scroll-bar
+ 'mode-line 'header-line)))
+ (if (consp binding)
+ ;; With modifiers, bind only the buffer area (no prefix).
+ (list `[(,@(car binding) ,event)])
+ ;; No modifier: bind also some non-buffer areas of the screen.
+ (cons (vector event)
+ (mapcar (lambda (prefix) (vector prefix event)) prefixes)))))
(define-minor-mode mouse-wheel-mode
"Toggle mouse wheel support (Mouse Wheel mode)."
@@ -371,12 +423,7 @@ This is a helper function for `mouse-wheel-mode'."
:global t
:group 'mouse
;; Remove previous bindings, if any.
- (mouse-wheel--remove-bindings mwheel-installed-bindings
- '(mwheel-scroll))
- (mouse-wheel--remove-bindings mwheel-installed-text-scale-bindings
- '(mouse-wheel-text-scale))
- (setq mwheel-installed-bindings nil)
- (setq mwheel-installed-text-scale-bindings nil)
+ (mouse-wheel--remove-bindings)
;; Setup bindings as needed.
(when mouse-wheel-mode
(dolist (binding mouse-wheel-scroll-amount)
@@ -384,16 +431,16 @@ This is a helper function for `mouse-wheel-mode'."
;; Bindings for changing font size.
((and (consp binding) (eq (cdr binding) 'text-scale))
(dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
- (let ((key `[,(list (caar binding) event)]))
- (global-set-key key 'mouse-wheel-text-scale)
- (push key mwheel-installed-text-scale-bindings))))
+ (mouse-wheel--add-binding `[,(list (caar binding) event)]
+ 'mouse-wheel-text-scale)))
;; Bindings for scrolling.
(t
(dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
- mouse-wheel-right-event mouse-wheel-left-event))
- (let ((key `[(,@(if (consp binding) (car binding)) ,event)]))
- (global-set-key key 'mwheel-scroll)
- (push key mwheel-installed-bindings))))))))
+ mouse-wheel-left-event mouse-wheel-right-event))
+ (dolist (key (mouse-wheel--create-scroll-keys binding event))
+ (mouse-wheel--add-binding key 'mwheel-scroll))))))))
+
+;;; Obsolete.
;;; Compatibility entry point
;; preloaded ;;;###autoload
@@ -402,6 +449,12 @@ This is a helper function for `mouse-wheel-mode'."
(declare (obsolete mouse-wheel-mode "27.1"))
(mouse-wheel-mode (if uninstall -1 1)))
+(defvar mwheel-installed-bindings nil)
+(make-obsolete-variable 'mwheel-installed-bindings nil "28.1")
+
+(defvar mwheel-installed-text-scale-bindings nil)
+(make-obsolete-variable 'mwheel-installed-text-scale-bindings nil "28.1")
+
(provide 'mwheel)
;;; mwheel.el ends here
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 92ed98b2a89..e0c162df577 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -838,7 +838,7 @@ If nil, prompt the user for a password."
"If non-nil, regexp matching hosts on which `dir' command lists directory."
:group 'ange-ftp
:type '(choice (const :tag "Default" nil)
- string))
+ regexp))
(defcustom ange-ftp-binary-file-name-regexp ""
"If a file matches this regexp then it is transferred in binary mode."
@@ -3427,8 +3427,7 @@ system TYPE.")
(and (file-directory-p name)
(file-readable-p name)))
-(defun ange-ftp-directory-files (directory &optional full match
- &rest v19-args)
+(defun ange-ftp-directory-files (directory &optional full match nosort count)
(setq directory (expand-file-name directory))
(if (ange-ftp-ftp-name directory)
(progn
@@ -3443,19 +3442,21 @@ system TYPE.")
(if (or (not match) (string-match-p match f))
(setq files
(cons (if full (concat directory f) f) files))))
+ (when (natnump count)
+ (setq files (last files count)))
(nreverse files)))
- (apply 'ange-ftp-real-directory-files directory full match v19-args)))
+ (apply 'ange-ftp-real-directory-files directory full match nosort count)))
(defun ange-ftp-directory-files-and-attributes
- (directory &optional full match nosort id-format)
+ (directory &optional full match nosort id-format count)
(setq directory (expand-file-name directory))
(if (ange-ftp-ftp-name directory)
(mapcar
(lambda (file)
(cons file (file-attributes (expand-file-name file directory))))
- (ange-ftp-directory-files directory full match nosort))
+ (ange-ftp-directory-files directory full match nosort count))
(ange-ftp-real-directory-files-and-attributes
- directory full match nosort id-format)))
+ directory full match nosort id-format count)))
(defun ange-ftp-file-attributes (file &optional id-format)
(setq file (expand-file-name file))
@@ -3535,20 +3536,22 @@ system TYPE.")
(setq file (expand-file-name file))
(let ((parsed (ange-ftp-ftp-name file)))
(if parsed
- (let* ((host (nth 0 parsed))
- (user (nth 1 parsed))
- (name (ange-ftp-quote-string (nth 2 parsed)))
- (abbr (ange-ftp-abbreviate-filename file))
- (result (ange-ftp-send-cmd host user
- (list 'delete name)
- (format "Deleting %s" abbr))))
- (or (car result)
- (signal 'ftp-error
- (list
- "Removing old name"
- (format "FTP Error: \"%s\"" (cdr result))
- file)))
- (ange-ftp-delete-file-entry file))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash file)
+ (let* ((host (nth 0 parsed))
+ (user (nth 1 parsed))
+ (name (ange-ftp-quote-string (nth 2 parsed)))
+ (abbr (ange-ftp-abbreviate-filename file))
+ (result (ange-ftp-send-cmd host user
+ (list 'delete name)
+ (format "Deleting %s" abbr))))
+ (or (car result)
+ (signal 'ftp-error
+ (list
+ "Removing old name"
+ (format "FTP Error: \"%s\"" (cdr result))
+ file)))
+ (ange-ftp-delete-file-entry file)))
(ange-ftp-real-delete-file file trash))))
(defun ange-ftp-file-modtime (file)
@@ -4162,46 +4165,55 @@ directory, so that Emacs will know its current contents."
(defun ange-ftp-delete-directory (dir &optional recursive trash)
(if (file-directory-p dir)
- (let ((parsed (ange-ftp-ftp-name dir)))
- (if recursive
- (mapc
- (lambda (file)
- (if (file-directory-p file)
- (ange-ftp-delete-directory file recursive trash)
- (delete-file file trash)))
- ;; We do not want to delete "." and "..".
- (directory-files dir 'full (rx (or (not ".") "...")))))
- (if parsed
- (let* ((host (nth 0 parsed))
- (user (nth 1 parsed))
- ;; Some ftp's on unix machines (at least on Suns)
- ;; insist that rmdir take a filename, and not a
- ;; directory-name name as an arg. Argh!! This is a bug.
- ;; Non-unix machines will probably always insist
- ;; that rmdir takes a directory-name as an arg
- ;; (as the ftp man page says it should).
- (name (ange-ftp-quote-string
- (if (eq (ange-ftp-host-type host) 'unix)
- (ange-ftp-real-directory-file-name
- (nth 2 parsed))
- (ange-ftp-real-file-name-as-directory
- (nth 2 parsed)))))
- (abbr (ange-ftp-abbreviate-filename dir))
- (result
- (progn
- ;; CWD must not in this directory.
- (ange-ftp-cd host user "/" 'noerror)
- (ange-ftp-send-cmd host user
- (list 'rmdir name)
- (format "Removing directory %s"
- abbr)))))
- (or (car result)
- (ange-ftp-error host user
- (format "Could not remove directory %s: %s"
- dir
- (cdr result))))
- (ange-ftp-delete-file-entry dir t))
- (ange-ftp-real-delete-directory dir recursive trash)))
+ ;; Trashing directories does not work yet, because
+ ;; `rename-file', called in `move-file-to-trash', does not
+ ;; handle directories.
+ (if nil ; (and delete-by-moving-to-trash trash)
+ ;; Move non-empty dir to trash only if recursive deletion was
+ ;; requested.
+ (if (not (or recursive (directory-empty-p dir)))
+ (signal 'ftp-error
+ (list "Directory is not empty, not moving to trash"))
+ (move-file-to-trash dir))
+ (let ((parsed (ange-ftp-ftp-name dir)))
+ (if recursive
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (ange-ftp-delete-directory file recursive)
+ (delete-file file)))
+ (directory-files dir 'full directory-files-no-dot-files-regexp)))
+ (if parsed
+ (let* ((host (nth 0 parsed))
+ (user (nth 1 parsed))
+ ;; Some ftp's on unix machines (at least on Suns)
+ ;; insist that rmdir take a filename, and not a
+ ;; directory-name name as an arg. Argh!! This is a bug.
+ ;; Non-unix machines will probably always insist
+ ;; that rmdir takes a directory-name as an arg
+ ;; (as the ftp man page says it should).
+ (name (ange-ftp-quote-string
+ (if (eq (ange-ftp-host-type host) 'unix)
+ (ange-ftp-real-directory-file-name
+ (nth 2 parsed))
+ (ange-ftp-real-file-name-as-directory
+ (nth 2 parsed)))))
+ (abbr (ange-ftp-abbreviate-filename dir))
+ (result
+ (progn
+ ;; CWD must not in this directory.
+ (ange-ftp-cd host user "/" 'noerror)
+ (ange-ftp-send-cmd host user
+ (list 'rmdir name)
+ (format "Removing directory %s"
+ abbr)))))
+ (or (car result)
+ (ange-ftp-error host user
+ (format "Could not remove directory %s: %s"
+ dir
+ (cdr result))))
+ (ange-ftp-delete-file-entry dir t))
+ (ange-ftp-real-delete-directory dir recursive trash))))
(error "Not a directory: %s" dir)))
;; Make a local copy of FILE and return its name.
@@ -4739,7 +4751,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
(setq ange-ftp-ls-cache-file nil) ;Stop confusing Dired.
0)
-(defun ange-ftp-set-file-modes (filename mode)
+(defun ange-ftp-set-file-modes (filename mode &optional flag)
+ flag ;; FIXME: Support 'nofollow'.
(ange-ftp-call-chmod (list (format "%o" mode) filename)))
(defun ange-ftp-make-symbolic-link (&rest _arguments)
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 25aabf6d61d..8b245b01066 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1,4 +1,4 @@
-;;; browse-url.el --- pass a URL to a WWW browser
+;;; browse-url.el --- pass a URL to a WWW browser -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2020 Free Software Foundation, Inc.
@@ -39,7 +39,6 @@
;; browse-url-chrome Chrome 47.0.2526.111
;; browse-url-chromium Chromium 3.0
;; browse-url-epiphany Epiphany Don't know
-;; browse-url-conkeror Conkeror Don't know
;; browse-url-w3 w3 0
;; browse-url-text-* Any text browser 0
;; browse-url-generic arbitrary
@@ -114,13 +113,29 @@
;; To always save modified buffers before displaying the file in a browser:
;; (setq browse-url-save-file t)
-;; To invoke different browsers for different URLs:
-;; (setq browse-url-browser-function '(("^mailto:" . browse-url-mail)
-;; ("." . browse-url-firefox)))
+;; To invoke different browsers/tools for different URLs, customize
+;; `browse-url-handlers'. In earlier versions of Emacs, the same
+;; could be done by setting `browse-url-browser-function' to an alist
+;; but this usage is deprecated now.
+
+;; All browser functions provided by here have a
+;; `browse-url-browser-kind' symbol property set to either `internal'
+;; or `external' which determines if they browse the given URL inside
+;; Emacs or spawn an external application with it. Some parts of
+;; Emacs make use of that, e.g., when an URL is dragged into Emacs, it
+;; is not sensible to invoke an external browser with it, so here only
+;; internal browsers are considered. Therefore, it is advised to put
+;; that property also on custom browser functions.
+;; (function-put 'my-browse-url-in-emacs 'browse-url-browser-kind
+;; 'internal)
+;; (function-put 'my-browse-url-externally 'browse-url-browser-kind
+;; 'external)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code:
+(require 'url)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables
@@ -140,7 +155,6 @@
(function-item :tag "Google Chrome" :value browse-url-chrome)
(function-item :tag "Chromium" :value browse-url-chromium)
(function-item :tag "Epiphany" :value browse-url-epiphany)
- (function-item :tag "Conkeror" :value browse-url-conkeror)
(function-item :tag "Text browser in an xterm window"
:value browse-url-text-xterm)
(function-item :tag "Text browser in an Emacs window"
@@ -157,7 +171,9 @@
:value browse-url-default-browser)
(function :tag "Your own function")
(alist :tag "Regexp/function association list"
- :key-type regexp :value-type function)))
+ :key-type regexp :value-type function
+ :format "%{%t%}\n%d%v\n"
+ :doc "Deprecated. Use `browse-url-handlers' instead.")))
;;;###autoload
(defcustom browse-url-browser-function 'browse-url-default-browser
@@ -165,13 +181,8 @@
This is used by the `browse-url-at-point', `browse-url-at-mouse', and
`browse-url-of-file' commands.
-If the value is not a function it should be a list of pairs
-\(REGEXP . FUNCTION). In this case the function called will be the one
-associated with the first REGEXP which matches the current URL. The
-function is passed the URL and any other args of `browse-url'. The last
-regexp should probably be \".\" to specify a default browser.
-
-Also see `browse-url-secondary-browser-function'."
+Also see `browse-url-secondary-browser-function' and
+`browse-url-handlers'."
:type browse-url--browser-defcustom-type
:version "24.1")
@@ -216,7 +227,7 @@ be used instead."
"\\(?:"
;; Match paired parentheses, e.g. in Wikipedia URLs:
;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com
- "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)"
+ "[" chars punct "]+" "(" "[" chars punct "]+" ")"
"\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
"\\|"
"[" chars punct "]+" "[" chars "]"
@@ -385,6 +396,8 @@ If non-nil, then open the URL in a new buffer rather than a new window if
:version "25.1"
:type 'boolean)
+(make-obsolete-variable 'browse-url-conkeror-new-window-is-buffer nil "28.1")
+
(defcustom browse-url-galeon-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
@@ -414,35 +427,20 @@ Passing an interactive argument to \\[browse-url], or specific browser
commands reverses the effect of this variable."
:type 'boolean)
-(defcustom browse-url-mosaic-program "xmosaic"
- "The name by which to invoke Mosaic (or mMosaic)."
- :type 'string
- :version "20.3")
-
-(make-obsolete-variable 'browse-url-mosaic-program nil "25.1")
-
-(defcustom browse-url-mosaic-arguments nil
- "A list of strings to pass to Mosaic as arguments."
- :type '(repeat (string :tag "Argument")))
-
-(make-obsolete-variable 'browse-url-mosaic-arguments nil "25.1")
-
-(defcustom browse-url-mosaic-pidfile "~/.mosaicpid"
- "The name of the pidfile created by Mosaic."
- :type 'string)
-
-(make-obsolete-variable 'browse-url-mosaic-pidfile nil "25.1")
-
(defcustom browse-url-conkeror-program "conkeror"
"The name by which to invoke Conkeror."
:type 'string
:version "25.1")
+(make-obsolete-variable 'browse-url-conkeror-program nil "28.1")
+
(defcustom browse-url-conkeror-arguments nil
"A list of strings to pass to Conkeror as arguments."
:version "25.1"
:type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'browse-url-conkeror-arguments nil "28.1")
+
(defcustom browse-url-filename-alist
`(("^/\\(ftp@\\|anonymous@\\)?\\([^:/]+\\):/*" . "ftp://\\2/")
;; The above loses the username to avoid the browser prompting for
@@ -483,22 +481,6 @@ Used by the `browse-url-of-file' command."
"Hook run after `browse-url-of-file' has asked a browser to load a file."
:type 'hook)
-(defcustom browse-url-CCI-port 3003
- "Port to access XMosaic via CCI.
-This can be any number between 1024 and 65535 but must correspond to
-the value set in the browser."
- :type 'integer)
-
-(make-obsolete-variable 'browse-url-CCI-port nil "25.1")
-
-(defcustom browse-url-CCI-host "localhost"
- "Host to access XMosaic via CCI.
-This should be the host name of the machine running XMosaic with CCI
-enabled. The port number should be set in `browse-url-CCI-port'."
- :type 'string)
-
-(make-obsolete-variable 'browse-url-CCI-host nil "25.1")
-
(defvar browse-url-temp-file-name nil)
(make-variable-buffer-local 'browse-url-temp-file-name)
@@ -595,6 +577,116 @@ down (this *won't* always work)."
"Wrapper command prepended to the Elinks command-line."
:type '(repeat (string :tag "Wrapper")))
+(defun browse-url--browser-kind (function url)
+ "Return the browser kind of a browser FUNCTION for URL.
+The browser kind is either `internal' (the browser runs inside
+Emacs), `external' (the browser is spawned in an external
+process), or nil (we don't know)."
+ (let ((kind (if (symbolp function)
+ (get function 'browse-url-browser-kind))))
+ (if (functionp kind)
+ (funcall kind url)
+ kind)))
+
+(defun browse-url--mailto (url &rest args)
+ "Call `browse-url-mailto-function' with URL and ARGS."
+ (funcall browse-url-mailto-function url args))
+
+(defun browse-url--browser-kind-mailto (url)
+ (browse-url--browser-kind browse-url-mailto-function url))
+(function-put 'browse-url--mailto 'browse-url-browser-kind
+ #'browse-url--browser-kind-mailto)
+
+(defun browse-url--man (url &rest args)
+ "Call `browse-url-man-function' with URL and ARGS."
+ (funcall browse-url-man-function url args))
+
+(defun browse-url--browser-kind-man (url)
+ (browse-url--browser-kind browse-url-man-function url))
+(function-put 'browse-url--man 'browse-url-browser-kind
+ #'browse-url--browser-kind-man)
+
+(defun browse-url--browser (url &rest args)
+ "Call `browse-url-browser-function' with URL and ARGS."
+ (funcall browse-url-browser-function url args))
+
+(defun browse-url--browser-kind-browser (url)
+ (browse-url--browser-kind browse-url-browser-function url))
+(function-put 'browse-url--browser 'browse-url-browser-kind
+ #'browse-url--browser-kind-browser)
+
+(defun browse-url--non-html-file-url-p (url)
+ "Return non-nil if URL is a file:// URL of a non-HTML file."
+ (and (string-match-p "\\`file://" url)
+ (not (string-match-p "\\`file://.*\\.html?\\b" url))))
+
+;;;###autoload
+(defvar browse-url-default-handlers
+ '(("\\`mailto:" . browse-url--mailto)
+ ("\\`man:" . browse-url--man)
+ (browse-url--non-html-file-url-p . browse-url-emacs))
+ "Like `browse-url-handlers' but populated by Emacs and packages.
+
+Emacs and external packages capable of browsing certain URLs
+should place their entries in this alist rather than
+`browse-url-handlers' which is reserved for the user.")
+
+(defcustom browse-url-handlers nil
+ "An alist with elements of the form (REGEXP-OR-PREDICATE . HANDLER).
+Each REGEXP-OR-PREDICATE is matched against the URL to be opened
+in turn and the first match's HANDLER is invoked with the URL.
+
+A HANDLER must be a function with the same arguments as
+`browse-url'.
+
+If no REGEXP-OR-PREDICATE matches, the same procedure is
+performed with the value of `browse-url-default-handlers'. If
+there is also no match, the URL is opened using the value of
+`browse-url-browser-function'."
+ :type '(alist :key-type (choice
+ (regexp :tag "Regexp")
+ (function :tag "Predicate"))
+ :value-type (function :tag "Handler"))
+ :version "28.1")
+
+;;;###autoload
+(defun browse-url-select-handler (url &optional kind)
+ "Return a handler of suitable for browsing URL.
+This searches `browse-url-handlers', and
+`browse-url-default-handlers' for a matching handler. Return nil
+if no handler is found.
+
+If KIND is given, the search is restricted to handlers whose
+function symbol has the symbol-property `browse-url-browser-kind'
+set to KIND.
+
+Currently, it also consults `browse-url-browser-function' first
+if it is set to an alist, although this usage is deprecated since
+Emacs 28.1 and will be removed in a future release."
+ (catch 'custom-url-handler
+ (dolist (rxpred-handler
+ (append
+ ;; The alist choice of browse-url-browser-function
+ ;; is deprecated since 28.1, so the (unless ...)
+ ;; can be removed at some point in time.
+ (when (and (consp browse-url-browser-function)
+ (not (functionp browse-url-browser-function)))
+ (lwarn 'browse-url :warning
+ "Having `browse-url-browser-function' set to an
+alist is deprecated. Use `browse-url-handlers' instead.")
+ browse-url-browser-function)
+ browse-url-handlers
+ browse-url-default-handlers))
+ (let ((rx-or-pred (car rxpred-handler))
+ (handler (cdr rxpred-handler)))
+ (when (and (or (null kind)
+ (eq kind (browse-url--browser-kind
+ handler url)))
+ (if (functionp rx-or-pred)
+ (funcall rx-or-pred url)
+ (string-match-p rx-or-pred url)))
+ (throw 'custom-url-handler handler))))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL encoding
@@ -729,8 +821,8 @@ narrowed."
(browse-url-of-file file-name))))
(defun browse-url-delete-temp-file (&optional temp-file-name)
- ;; Delete browse-url-temp-file-name from the file system
- ;; If optional arg TEMP-FILE-NAME is non-nil, delete it instead
+ "Delete `browse-url-temp-file-name' from the file system.
+If optional arg TEMP-FILE-NAME is non-nil, delete it instead."
(let ((file-name (or temp-file-name browse-url-temp-file-name)))
(if (and file-name (file-exists-p file-name))
(delete-file file-name))))
@@ -768,16 +860,18 @@ narrowed."
"Ask a WWW browser to load URL.
Prompt for a URL, defaulting to the URL at or before point.
Invokes a suitable browser function which does the actual job.
-The variable `browse-url-browser-function' says which browser function to
-use. If the URL is a mailto: URL, consult `browse-url-mailto-function'
-first, if that exists.
-
-The additional ARGS are passed to the browser function. See the doc
-strings of the actual functions, starting with `browse-url-browser-function',
-for information about the significance of ARGS (most of the functions
-ignore it).
-If ARGS are omitted, the default is to pass `browse-url-new-window-flag'
-as ARGS."
+
+The variables `browse-url-browser-function',
+`browse-url-handlers', and `browse-url-default-handlers'
+determine which browser function to use.
+
+The additional ARGS are passed to the browser function. See the
+doc strings of the actual functions, starting with
+`browse-url-browser-function', for information about the
+significance of ARGS (most of the functions ignore it).
+
+If ARGS are omitted, the default is to pass
+`browse-url-new-window-flag' as ARGS."
(interactive (browse-url-interactive-arg "URL: "))
(unless (called-interactively-p 'interactive)
(setq args (or args (list browse-url-new-window-flag))))
@@ -786,12 +880,9 @@ as ARGS."
(not (string-match "\\`[a-z]+:" url)))
(setq url (expand-file-name url)))
(let ((process-environment (copy-sequence process-environment))
- (function (or (and (string-match "\\`mailto:" url)
- browse-url-mailto-function)
- (and (string-match "\\`man:" url)
- browse-url-man-function)
- browse-url-browser-function))
- ;; Ensure that `default-directory' exists and is readable (b#6077).
+ (function (or (browse-url-select-handler url)
+ browse-url-browser-function))
+ ;; Ensure that `default-directory' exists and is readable (bug#6077).
(default-directory (or (unhandled-file-name-directory default-directory)
(expand-file-name "~/"))))
;; When connected to various displays, be careful to use the display of
@@ -799,20 +890,9 @@ as ARGS."
;; which may not even exist any more.
(if (stringp (frame-parameter nil 'display))
(setenv "DISPLAY" (frame-parameter nil 'display)))
- (if (and (consp function)
- (not (functionp function)))
- ;; The `function' can be an alist; look down it for first match
- ;; and apply the function (which might be a lambda).
- (catch 'done
- (dolist (bf function)
- (when (string-match (car bf) url)
- (apply (cdr bf) url args)
- (throw 'done t)))
- (error "No browse-url-browser-function matching URL %s"
- url))
- ;; Unbound symbols go down this leg, since void-function from
- ;; apply is clearer than wrong-type-argument from dolist.
- (apply function url args))))
+ (if (functionp function)
+ (apply function url args)
+ (error "No suitable browser for URL %s" url))))
;;;###autoload
(defun browse-url-at-point (&optional arg)
@@ -829,6 +909,34 @@ Optional prefix argument ARG non-nil inverts the value of the option
(error "No URL found"))))
;;;###autoload
+(defun browse-url-with-browser-kind (kind url &optional arg)
+ "Browse URL with a browser of the given browser KIND.
+KIND is either `internal' or `external'.
+
+When called interactively, the default browser kind is the
+opposite of the browser kind of `browse-url-browser-function'."
+ (interactive
+ (let* ((url-arg (browse-url-interactive-arg "URL: "))
+ ;; Default to the inverse kind of the default browser.
+ (default (if (eq (browse-url--browser-kind
+ browse-url-browser-function (car url-arg))
+ 'internal)
+ 'external
+ 'internal))
+ (k (intern (completing-read
+ (format-prompt "Browser kind" default)
+ '(internal external)
+ nil t nil nil
+ default))))
+ (cons k url-arg)))
+ (let ((function (browse-url-select-handler url kind)))
+ (unless function
+ (setq function (if (eq kind 'external)
+ #'browse-url-default-browser
+ #'eww)))
+ (funcall function url arg)))
+
+;;;###autoload
(defun browse-url-at-mouse (event)
"Ask a WWW browser to load a URL clicked with the mouse.
The URL is the one around or before the position of the mouse click
@@ -875,12 +983,18 @@ The optional NEW-WINDOW argument is not used."
(url-unhex-string url)
url)))))
+(function-put 'browse-url-default-windows-browser 'browse-url-browser-kind
+ 'external)
+
(defun browse-url-default-macosx-browser (url &optional _new-window)
"Invoke the macOS system's default Web browser.
The optional NEW-WINDOW argument is not used."
(interactive (browse-url-interactive-arg "URL: "))
(start-process (concat "open " url) nil "open" url))
+(function-put 'browse-url-default-macosx-browser 'browse-url-browser-kind
+ 'external)
+
;; --- Netscape ---
(defun browse-url-process-environment ()
@@ -928,8 +1042,6 @@ instead of `browse-url-new-window-flag'."
;;; ((executable-find browse-url-galeon-program) 'browse-url-galeon)
((executable-find browse-url-kde-program) 'browse-url-kde)
;;; ((executable-find browse-url-netscape-program) 'browse-url-netscape)
-;;; ((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
- ((executable-find browse-url-conkeror-program) 'browse-url-conkeror)
((executable-find browse-url-chrome-program) 'browse-url-chrome)
((executable-find browse-url-xterm-program) 'browse-url-text-xterm)
((locate-library "w3") 'browse-url-w3)
@@ -937,6 +1049,10 @@ instead of `browse-url-new-window-flag'."
(lambda (&rest _ignore) (error "No usable browser found"))))
url args))
+(function-put 'browse-url-default-browser 'browse-url-browser-kind
+ ;; Well, most probably external if we ignore w3.
+ 'external)
+
(defun browse-url-can-use-xdg-open ()
"Return non-nil if the \"xdg-open\" program can be used.
xdg-open is a desktop utility that calls your preferred web browser."
@@ -956,6 +1072,8 @@ The optional argument IGNORED is not used."
(interactive (browse-url-interactive-arg "URL: "))
(call-process "xdg-open" nil 0 nil url))
+(function-put 'browse-url-xdg-open 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-netscape (url &optional new-window)
"Ask the Netscape WWW browser to load URL.
@@ -999,6 +1117,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-netscape-sentinel process ,url)))))
+(function-put 'browse-url-netscape 'browse-url-browser-kind 'external)
+
(defun browse-url-netscape-sentinel (process url)
"Handle a change to the process communicating with Netscape."
(declare (obsolete nil "25.1"))
@@ -1069,6 +1189,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-mozilla-sentinel process ,url)))))
+(function-put 'browse-url-mozilla 'browse-url-browser-kind 'external)
+
(defun browse-url-mozilla-sentinel (process url)
"Handle a change to the process communicating with Mozilla."
(or (eq (process-exit-status process) 0)
@@ -1109,6 +1231,8 @@ instead of `browse-url-new-window-flag'."
'("-new-window")))
(list url)))))
+(function-put 'browse-url-firefox 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-chromium (url &optional _new-window)
"Ask the Chromium WWW browser to load URL.
@@ -1126,6 +1250,8 @@ The optional argument NEW-WINDOW is not used."
browse-url-chromium-arguments
(list url)))))
+(function-put 'browse-url-chromium 'browse-url-browser-kind 'external)
+
(defun browse-url-chrome (url &optional _new-window)
"Ask the Google Chrome WWW browser to load URL.
Default to the URL around or before point. The strings in
@@ -1142,6 +1268,8 @@ The optional argument NEW-WINDOW is not used."
browse-url-chrome-arguments
(list url)))))
+(function-put 'browse-url-chrome 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-galeon (url &optional new-window)
"Ask the Galeon WWW browser to load URL.
@@ -1179,6 +1307,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-galeon-sentinel process ,url)))))
+(function-put 'browse-url-galeon 'browse-url-browser-kind 'external)
+
(defun browse-url-galeon-sentinel (process url)
"Handle a change to the process communicating with Galeon."
(declare (obsolete nil "25.1"))
@@ -1225,6 +1355,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-epiphany-sentinel process ,url)))))
+(function-put 'browse-url-epiphany 'browse-url-browser-kind 'external)
+
(defun browse-url-epiphany-sentinel (process url)
"Handle a change to the process communicating with Epiphany."
(or (eq (process-exit-status process) 0)
@@ -1244,10 +1376,18 @@ Optional argument SAME-WINDOW non-nil means show the URL in the
currently selected window instead."
(interactive (browse-url-interactive-arg "URL: "))
(require 'url-handlers)
- (let ((file-name-handler-alist
- (cons (cons url-handler-regexp 'url-file-handler)
- file-name-handler-alist)))
- (if same-window (find-file url) (find-file-other-window url))))
+ (let ((parsed (url-generic-parse-url url))
+ (func (if same-window 'find-file 'find-file-other-window)))
+ (if (and (equal (url-type parsed) "file")
+ (file-directory-p (url-filename parsed)))
+ ;; It's a directory; just open it.
+ (funcall func (url-filename parsed))
+ (let ((file-name-handler-alist
+ (cons (cons url-handler-regexp 'url-file-handler)
+ file-name-handler-alist)))
+ (funcall func url)))))
+
+(function-put 'browse-url-emacs 'browse-url-browser-kind 'internal)
;;;###autoload
(defun browse-url-gnome-moz (url &optional new-window)
@@ -1273,88 +1413,7 @@ used instead of `browse-url-new-window-flag'."
'("--newwin"))
(list "--raise" url))))
-;; --- Mosaic ---
-
-;;;###autoload
-(defun browse-url-mosaic (url &optional new-window)
- "Ask the XMosaic WWW browser to load URL.
-
-Default to the URL around or before point. The strings in variable
-`browse-url-mosaic-arguments' are also passed to Mosaic and the
-program is invoked according to the variable
-`browse-url-mosaic-program'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Mosaic window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
- (declare (obsolete nil "25.1"))
- (interactive (browse-url-interactive-arg "Mosaic URL: "))
- (let ((pidfile (expand-file-name browse-url-mosaic-pidfile))
- pid)
- (if (file-readable-p pidfile)
- (with-temp-buffer
- (insert-file-contents pidfile)
- (setq pid (read (current-buffer)))))
- (if (and (integerp pid) (zerop (signal-process pid 0))) ; Mosaic running
- (progn
- (with-temp-buffer
- (insert (if (browse-url-maybe-new-window new-window)
- "newwin\n"
- "goto\n")
- url "\n")
- (with-file-modes ?\700
- (if (file-exists-p
- (setq pidfile (format "/tmp/Mosaic.%d" pid)))
- (delete-file pidfile))
- ;; https://debbugs.gnu.org/17428. Use O_EXCL.
- (write-region nil nil pidfile nil 'silent nil 'excl)))
- ;; Send signal SIGUSR to Mosaic
- (message "Signaling Mosaic...")
- (signal-process pid 'SIGUSR1)
- ;; Or you could try:
- ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid))
- (message "Signaling Mosaic...done"))
- ;; Mosaic not running - start it
- (message "Starting %s..." browse-url-mosaic-program)
- (apply 'start-process "xmosaic" nil browse-url-mosaic-program
- (append browse-url-mosaic-arguments (list url)))
- (message "Starting %s...done" browse-url-mosaic-program))))
-
-;; --- Mosaic using CCI ---
-
-;;;###autoload
-(defun browse-url-cci (url &optional new-window)
- "Ask the XMosaic WWW browser to load URL.
-Default to the URL around or before point.
-
-This function only works for XMosaic version 2.5 or later. You must
-select `CCI' from XMosaic's File menu, set the CCI Port Address to the
-value of variable `browse-url-CCI-port', and enable `Accept requests'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new browser window, otherwise use a
-random existing one. A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
- (declare (obsolete nil "25.1"))
- (interactive (browse-url-interactive-arg "Mosaic URL: "))
- (open-network-stream "browse-url" " *browse-url*"
- browse-url-CCI-host browse-url-CCI-port)
- ;; Todo: start browser if fails
- (process-send-string "browse-url"
- (concat "get url (" url ") output "
- (if (browse-url-maybe-new-window new-window)
- "new"
- "current")
- "\r\n"))
- (process-send-string "browse-url" "disconnect\r\n")
- (delete-process "browse-url"))
+(function-put 'browse-url-gnome-moz 'browse-url-browser-kind 'external)
;; --- Conkeror ---
;;;###autoload
@@ -1375,6 +1434,7 @@ new window, load it in a new buffer in an existing window instead.
When called non-interactively, use optional second argument
NEW-WINDOW instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "28.1"))
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
@@ -1392,6 +1452,9 @@ NEW-WINDOW instead of `browse-url-new-window-flag'."
"window")
"buffer")
url))))))
+
+(function-put 'browse-url-conkeror 'browse-url-browser-kind 'external)
+
;; --- W3 ---
;; External.
@@ -1415,6 +1478,8 @@ used instead of `browse-url-new-window-flag'."
(w3-fetch-other-window url)
(w3-fetch url)))
+(function-put 'browse-url-w3 'browse-url-browser-kind 'internal)
+
;;;###autoload
(defun browse-url-w3-gnudoit (url &optional _new-window)
;; new-window ignored
@@ -1429,6 +1494,8 @@ The `browse-url-gnudoit-program' program is used with options given by
(list (concat "(w3-fetch \"" url "\")")
"(raise-frame)"))))
+(function-put 'browse-url-w3-gnudoit 'browse-url-browser-kind 'internal)
+
;; --- Lynx in an xterm ---
;;;###autoload
@@ -1446,6 +1513,8 @@ The optional argument NEW-WINDOW is not used."
,@browse-url-xterm-args "-e" ,browse-url-text-browser
,url)))
+(function-put 'browse-url-text-xterm 'browse-url-browser-kind 'external)
+
;; --- Lynx in an Emacs "term" window ---
(declare-function term-char-mode "term" ())
@@ -1520,6 +1589,8 @@ used instead of `browse-url-new-window-flag'."
url
"\r")))))
+(function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal)
+
;; --- mailto ---
(autoload 'rfc2368-parse-mailto-url "rfc2368")
@@ -1567,6 +1638,8 @@ used instead of `browse-url-new-window-flag'."
(unless (bolp)
(insert "\n"))))))))
+(function-put 'browse-url-mail 'browse-url-browser-kind 'internal)
+
;; --- man ---
(defvar manual-program)
@@ -1578,7 +1651,9 @@ used instead of `browse-url-new-window-flag'."
(setq url (replace-regexp-in-string "\\`man:" "" url))
(cond
((executable-find manual-program) (man url))
- (t (woman (replace-regexp-in-string "([[:alnum:]]+)" "" url)))))
+ (t (woman (replace-regexp-in-string "([[:alnum:]]+)" "" url)))))
+
+(function-put 'browse-url-man 'browse-url-browser-kind 'internal)
;; --- Random browser ---
@@ -1597,6 +1672,8 @@ don't offer a form of remote control."
0 nil
(append browse-url-generic-args (list url))))
+(function-put 'browse-url-generic 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-kde (url &optional _new-window)
"Ask the KDE WWW browser to load URL.
@@ -1607,6 +1684,8 @@ The optional argument NEW-WINDOW is not used."
(apply #'start-process (concat "KDE " url) nil browse-url-kde-program
(append browse-url-kde-args (list url))))
+(function-put 'browse-url-kde 'browse-url-browser-kind 'external)
+
(defun browse-url-elinks-new-window (url)
"Ask the Elinks WWW browser to load URL in a new window."
(let ((process-environment (browse-url-process-environment)))
@@ -1616,6 +1695,9 @@ The optional argument NEW-WINDOW is not used."
browse-url-elinks-wrapper
(list "elinks" url)))))
+(function-put 'browse-url-elinks-new-window 'browse-url-browser-kind
+ 'external)
+
;;;###autoload
(defun browse-url-elinks (url &optional new-window)
"Ask the Elinks WWW browser to load URL.
@@ -1637,6 +1719,8 @@ from `browse-url-elinks-wrapper'."
`(lambda (process change)
(browse-url-elinks-sentinel process ,url))))))
+(function-put 'browse-url-elinks 'browse-url-browser-kind 'external)
+
(defun browse-url-elinks-sentinel (process url)
"Determines if Elinks is running or a new one has to be started."
;; Try to determine if an instance is running or if we have to
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index cafbfa73c15..8b40808005b 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -51,11 +51,16 @@
(unless (boundp 'dbus-debug)
(defvar dbus-debug nil))
-;; Pacify byte compiler.
-(eval-when-compile (require 'cl-lib))
-
+(require 'cl-lib)
+(require 'seq)
+(require 'subr-x)
(require 'xml)
+;;; D-Bus constants.
+
+(defconst dbus-compound-types '(:array :variant :struct :dict-entry)
+ "D-Bus compound types, represented as list.")
+
(defconst dbus-service-dbus "org.freedesktop.DBus"
"The bus name used to talk to the bus itself.")
@@ -65,7 +70,8 @@
(defconst dbus-path-local (concat dbus-path-dbus "/Local")
"The object path used in local/in-process-generated messages.")
-;; Default D-Bus interfaces.
+
+;;; Default D-Bus interfaces.
(defconst dbus-interface-dbus "org.freedesktop.DBus"
"The interface exported by the service `dbus-service-dbus'.")
@@ -139,6 +145,17 @@ See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter
;; </signal>
;; </interface>
+(defconst dbus-interface-monitoring (concat dbus-interface-dbus ".Monitoring")
+ "The monitoring interface.
+See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#bus-messages-become-monitor'.")
+
+;; <interface name="org.freedesktop.DBus.Monitoring">
+;; <method name="BecomeMonitor">
+;; <arg name="rule" type="as" direction="in"/>
+;; <arg name="flags" type="u" direction="in"/> ;; Not used, must be 0.
+;; </method>
+;; </interface>
+
(defconst dbus-interface-local (concat dbus-interface-dbus ".Local")
"An interface whose methods can only be invoked by the local implementation.")
@@ -148,7 +165,60 @@ See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-inter
;; </signal>
;; </interface>
-;; Emacs defaults.
+(defconst dbus-annotation-deprecated (concat dbus-interface-dbus ".Deprecated")
+ "An annotation indicating a deprecated interface, method, signal, or property.")
+
+
+;;; Default D-Bus errors.
+
+(defgroup dbus nil
+ "Elisp bindings for D-Bus."
+ :group 'comm
+ :link '(custom-manual "(dbus)Top")
+ :version "28.1")
+
+(defconst dbus-error-dbus "org.freedesktop.DBus.Error"
+ "The namespace for default error names.
+See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
+
+(defconst dbus-error-access-denied (concat dbus-error-dbus ".AccessDenied")
+ "Security restrictions don't allow doing what you're trying to do.")
+
+(defconst dbus-error-disconnected (concat dbus-error-dbus ".Disconnected")
+ "The connection is disconnected and you're trying to use it.")
+
+(defconst dbus-error-failed (concat dbus-error-dbus ".Failed")
+ "A generic error; \"something went wrong\" - see the error message for more.")
+
+(defconst dbus-error-invalid-args (concat dbus-error-dbus ".InvalidArgs")
+ "Invalid arguments passed to a method call.")
+
+(defconst dbus-error-no-reply (concat dbus-error-dbus ".NoReply")
+ "No reply to a message expecting one, usually means a timeout occurred.")
+
+(defconst dbus-error-property-read-only
+ (concat dbus-error-dbus ".PropertyReadOnly")
+ "Property you tried to set is read-only.")
+
+(defconst dbus-error-service-unknown (concat dbus-error-dbus ".ServiceUnknown")
+ "The bus doesn't know how to launch a service to supply the bus name you wanted.")
+
+(defconst dbus-error-unknown-interface
+ (concat dbus-error-dbus ".UnknownInterface")
+ "Interface you invoked a method on isn't known by the object.")
+
+(defconst dbus-error-unknown-method (concat dbus-error-dbus ".UnknownMethod")
+ "Method name you invoked isn't known by the object you invoked it on.")
+
+(defconst dbus-error-unknown-object (concat dbus-error-dbus ".UnknownObject")
+ "Object you invoked a method on isn't known.")
+
+(defconst dbus-error-unknown-property (concat dbus-error-dbus ".UnknownProperty")
+ "Property you tried to access isn't known by the object.")
+
+
+;;; Emacs defaults.
+
(defconst dbus-service-emacs "org.gnu.Emacs"
"The well known service name of Emacs.")
@@ -160,7 +230,8 @@ shall be subdirectories of this path.")
(defconst dbus-interface-emacs "org.gnu.Emacs"
"The interface namespace used by Emacs.")
-;; D-Bus constants.
+
+;;; Basic D-Bus message functions.
(defmacro dbus-ignore-errors (&rest body)
"Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
@@ -169,22 +240,16 @@ Otherwise, return result of last form in BODY, or all other errors."
`(condition-case err
(progn ,@body)
(dbus-error (when dbus-debug (signal (car err) (cdr err))))))
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>"))
-(define-obsolete-variable-alias 'dbus-event-error-hooks
- 'dbus-event-error-functions "24.3")
(defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors)
"Functions to be called when a D-Bus error happens in the event handler.
Every function must accept two arguments, the event and the error variable
caught in `condition-case' by `dbus-error'.")
-
-;;; Basic D-Bus message functions.
-
-(defvar dbus-return-values-table (make-hash-table :test 'equal)
+(defvar dbus-return-values-table (make-hash-table :test #'equal)
"Hash table for temporarily storing arguments of reply messages.
A key in this hash table is a list (:serial BUS SERIAL), like in
-`dbus-registered-objects-table'. BUS is either a Lisp symbol,
+`dbus-registered-objects-table'. BUS is either a Lisp keyword,
`:system' or `:session', or a string denoting the bus address.
SERIAL is the serial number of the reply message.
@@ -218,8 +283,8 @@ The result will be made available in `dbus-return-values-table'."
(defun dbus-call-method (bus service path interface method &rest args)
"Call METHOD on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name to be used. PATH is the D-Bus
object path SERVICE is registered at. INTERFACE is an interface
@@ -240,8 +305,8 @@ converted into D-Bus types via the following rules:
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
+All arguments can be preceded by a type keyword. For details
+about type keywords, see Info node `(dbus)Type Conversion'.
`dbus-call-method' returns the resulting values of METHOD as a list of
Lisp objects. The type conversion happens the other direction as for
@@ -286,7 +351,8 @@ object is returned instead of a list containing this single Lisp object.
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -301,8 +367,8 @@ object is returned instead of a list containing this single Lisp object.
(check-interval 0.001)
(key
(apply
- 'dbus-message-internal dbus-message-type-method-call
- bus service path interface method 'dbus-call-method-handler args))
+ #'dbus-message-internal dbus-message-type-method-call
+ bus service path interface method #'dbus-call-method-handler args))
(result (cons :pending nil)))
;; Wait until `dbus-call-method-handler' has put the result into
@@ -319,35 +385,32 @@ object is returned instead of a list containing this single Lisp object.
(puthash key result dbus-return-values-table)
(unwind-protect
- (progn
- (with-timeout ((if timeout (/ timeout 1000.0) 25)
- (signal 'dbus-error (list "call timed out")))
- (while (eq (car result) :pending)
- (let ((event (let ((inhibit-redisplay t) unread-command-events)
- (read-event nil nil check-interval))))
- (when event
- (if (ignore-errors (dbus-check-event event))
- (setf result (gethash key dbus-return-values-table))
- (setf unread-command-events
- (nconc unread-command-events
- (cons event nil)))))
- (when (< check-interval 1)
- (setf check-interval (* check-interval 1.05))))))
- (when (eq (car result) :error)
- (signal (cadr result) (cddr result)))
- (cdr result))
+ (progn
+ (with-timeout
+ ((if timeout (/ timeout 1000.0) 25)
+ (signal 'dbus-error `(,dbus-error-no-reply "Call timed out")))
+ (while (eq (car result) :pending)
+ (let ((event (let ((inhibit-redisplay t) unread-command-events)
+ (read-event nil nil check-interval))))
+ (when event
+ (if (ignore-errors (dbus-check-event event))
+ (setf result (gethash key dbus-return-values-table))
+ (setf unread-command-events
+ (nconc unread-command-events
+ (cons event nil)))))
+ (when (< check-interval 1)
+ (setf check-interval (* check-interval 1.05))))))
+ (when (eq (car result) :error)
+ (signal (cadr result) (cddr result)))
+ (cdr result))
(remhash key dbus-return-values-table))))
-;; `dbus-call-method' works non-blocking now.
-(defalias 'dbus-call-method-non-blocking 'dbus-call-method)
-(make-obsolete 'dbus-call-method-non-blocking 'dbus-call-method "24.3")
-
(defun dbus-call-method-asynchronously
(bus service path interface method handler &rest args)
"Call METHOD on the D-Bus BUS asynchronously.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name to be used. PATH is the D-Bus
object path SERVICE is registered at. INTERFACE is an interface
@@ -372,8 +435,8 @@ converted into D-Bus types via the following rules:
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
+All arguments can be preceded by a type keyword. For details
+about type keywords, see Info node `(dbus)Type Conversion'.
If HANDLER is a Lisp function, the function returns a key into the
hash table `dbus-registered-objects-table'. The corresponding entry
@@ -384,7 +447,7 @@ Example:
\(dbus-call-method-asynchronously
:system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
- \"org.freedesktop.Hal.Device\" \"GetPropertyString\" \\='message
+ \"org.freedesktop.Hal.Device\" \"GetPropertyString\" #\\='message
\"system.kernel.machine\")
-| i686
@@ -393,7 +456,8 @@ Example:
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -406,15 +470,15 @@ Example:
(or (null handler) (functionp handler)
(signal 'wrong-type-argument (list 'functionp handler)))
- (apply 'dbus-message-internal dbus-message-type-method-call
+ (apply #'dbus-message-internal dbus-message-type-method-call
bus service path interface method handler args))
(defun dbus-send-signal (bus service path interface signal &rest args)
"Send signal SIGNAL on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. The signal is sent from the D-Bus object
-Emacs is registered at BUS.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. The signal is sent from the
+D-Bus object Emacs is registered at BUS.
SERVICE is the D-Bus name SIGNAL is sent to. It can be either a known
name or a unique name. If SERVICE is nil, the signal is sent as
@@ -432,8 +496,8 @@ converted into D-Bus types via the following rules:
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
-All arguments can be preceded by a type symbol. For details about
-type symbols, see Info node `(dbus)Type Conversion'.
+All arguments can be preceded by a type keyword. For details
+about type keywords, see Info node `(dbus)Type Conversion'.
Example:
@@ -443,7 +507,8 @@ Example:
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (null service) (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
@@ -454,7 +519,7 @@ Example:
(or (stringp signal)
(signal 'wrong-type-argument (list 'stringp signal)))
- (apply 'dbus-message-internal dbus-message-type-signal
+ (apply #'dbus-message-internal dbus-message-type-signal
bus service path interface signal args))
(defun dbus-method-return-internal (bus service serial &rest args)
@@ -463,31 +528,50 @@ This is an internal function, it shall not be used outside dbus.el."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (natnump serial)
(signal 'wrong-type-argument (list 'natnump serial)))
- (apply 'dbus-message-internal dbus-message-type-method-return
+ (apply #'dbus-message-internal dbus-message-type-method-return
bus service serial args))
-(defun dbus-method-error-internal (bus service serial &rest args)
+(defun dbus-method-error-internal (bus service serial error-name &rest args)
"Return error message for message SERIAL on the D-Bus BUS.
+ERROR-NAME must belong to the \"org.freedesktop.DBus.Error\" namespace.
This is an internal function, it shall not be used outside dbus.el."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (natnump serial)
(signal 'wrong-type-argument (list 'natnump serial)))
- (apply 'dbus-message-internal dbus-message-type-error
- bus service serial args))
+ (apply #'dbus-message-internal dbus-message-type-error
+ bus service serial error-name args))
+
+(defun dbus-check-arguments (bus service &rest args)
+ "Check arguments ARGS by side effect.
+BUS, SERVICE and ARGS have the same format as in `dbus-call-method'.
+Any wrong argument triggers a D-Bus error. Otherwise, return t.
+This is an internal function, it shall not be used outside dbus.el."
+
+ (or (featurep 'dbusbind)
+ (signal 'dbus-error (list "Emacs not compiled with dbus support")))
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
+ (signal 'wrong-type-argument (list 'keywordp bus)))
+ (or (stringp service)
+ (signal 'wrong-type-argument (list 'stringp service)))
+
+ (apply #'dbus-message-internal dbus-message-type-invalid bus service args))
;;; Hash table of registered functions.
@@ -506,8 +590,9 @@ hash table."
(defun dbus-setenv (bus variable value)
"Set the value of the BUS environment variable named VARIABLE to VALUE.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. Both VARIABLE and VALUE should be strings.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. Both VARIABLE and VALUE should
+be strings.
Normally, services inherit the environment of the BUS daemon. This
function adds to or modifies that environment when activating services.
@@ -521,8 +606,8 @@ Some bus instances, such as `:system', may disable setting the environment."
(defun dbus-register-service (bus service &rest flags)
"Register known name SERVICE on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name that should be registered. It must
be a known name.
@@ -553,12 +638,13 @@ placed in the queue.
;; Add Peer handler.
(dbus-register-method
- bus service nil dbus-interface-peer "Ping" 'dbus-peer-handler 'dont-register)
+ bus service nil dbus-interface-peer "Ping"
+ #'dbus-peer-handler 'dont-register)
;; Add ObjectManager handler.
(dbus-register-method
bus service nil dbus-interface-objectmanager "GetManagedObjects"
- 'dbus-managed-objects-handler 'dont-register)
+ #'dbus-managed-objects-handler 'dont-register)
(let ((arg 0)
reply)
@@ -582,8 +668,9 @@ placed in the queue.
(defun dbus-unregister-service (bus service)
"Unregister all objects related to SERVICE from D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. SERVICE must be a known service name.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. SERVICE must be a known service
+name.
The function returns a keyword, indicating the result of the
operation. One of the following keywords is returned:
@@ -597,7 +684,7 @@ queue of this service."
(maphash
(lambda (key value)
- (unless (equal :serial (car key))
+ (unless (eq :serial (car key))
(dolist (elt value)
(ignore-errors
(when (and (equal bus (cadr key)) (string-equal service (cadr elt)))
@@ -618,8 +705,8 @@ queue of this service."
(bus service path interface signal handler &rest args)
"Register for a signal on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name used by the sending D-Bus object.
It can be either a known name or the unique name of the D-Bus object
@@ -662,7 +749,7 @@ Example:
\(dbus-register-signal
:system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\"
- \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" \\='my-signal-handler)
+ \"org.freedesktop.Hal.Manager\" \"DeviceAdded\" #\\='my-signal-handler)
=> ((:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\")
(\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" my-signal-handler))
@@ -681,7 +768,7 @@ Example:
(if (and (stringp service)
(not (zerop (length service)))
(not (string-equal service dbus-service-dbus))
- (not (string-match "^:" service)))
+ (/= (string-to-char service) ?:))
(setq uname (dbus-get-name-owner bus service))
(setq uname service))
@@ -710,7 +797,7 @@ Example:
;; `:arg0' .. `:arg63', `:path0' .. `:path63'.
((and (keywordp key)
(string-match
- "^:\\(arg\\|path\\)\\([[:digit:]]+\\)$"
+ "\\`:\\(arg\\|path\\)\\([[:digit:]]+\\)\\'"
(symbol-name key)))
(setq counter (match-string 2 (symbol-name key))
args (cdr args)
@@ -726,9 +813,7 @@ Example:
"path" "")
value))
;; `:arg-namespace', `:path-namespace'.
- ((and (keywordp key)
- (string-match
- "^:\\(arg\\|path\\)-namespace$" (symbol-name key)))
+ ((memq key '(:arg-namespace :path-namespace))
(setq args (cdr args)
value (car args))
(unless (stringp value)
@@ -736,8 +821,7 @@ Example:
(list "Wrong argument" key value)))
(format
",%s='%s'"
- (if (string-equal (match-string 1 (symbol-name key)) "path")
- "path_namespace" "arg0namespace")
+ (if (eq key :path-namespace) "path_namespace" "arg0namespace")
value))
;; `:eavesdrop'.
((eq key :eavesdrop)
@@ -751,11 +835,11 @@ Example:
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"AddMatch" rule)
(dbus-error
- (if (not (string-match "eavesdrop" rule))
+ (if (not (string-match-p "eavesdrop" rule))
(signal (car err) (cdr err))
;; The D-Bus spec says we shall fall back to a rule without eavesdrop.
(when dbus-debug (message "Removing eavesdrop from rule %s" rule))
- (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule))
+ (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule t t))
(dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"AddMatch" rule))))
@@ -776,8 +860,8 @@ Example:
(bus service path interface method handler &optional dont-register-service)
"Register METHOD on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name of the D-Bus object METHOD is
registered for. It must be a known name (see discussion of
@@ -788,10 +872,18 @@ discussion of DONT-REGISTER-SERVICE below). INTERFACE is the
interface offered by SERVICE. It must provide METHOD.
HANDLER is a Lisp function to be called when a method call is
-received. It must accept the input arguments of METHOD. The return
-value of HANDLER is used for composing the returning D-Bus message.
-If HANDLER returns a reply message with an empty argument list,
-HANDLER must return the symbol `:ignore'.
+received. It must accept the input arguments of METHOD. The
+return value of HANDLER is used for composing the returning D-Bus
+message. If HANDLER returns a reply message with an empty
+argument list, HANDLER must return the keyword `:ignore' in order
+to distinguish it from nil (the boolean false).
+
+If HANDLER detects an error, it shall return the list `(:error
+ERROR-NAME ERROR-MESSAGE)'. ERROR-NAME is a namespaced string
+which characterizes the error type, and ERROR-MESSAGE is a free
+text string. Alternatively, any Emacs signal `dbus-error' in
+HANDLER raises a D-Bus error message with the error name
+\"org.freedesktop.DBus.Error.Failed\".
When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
registered. This means that other D-Bus clients have no way of
@@ -820,8 +912,9 @@ discovering the still incomplete interface."
(defun dbus-unregister-object (object)
"Unregister OBJECT from D-Bus.
OBJECT must be the result of a preceding `dbus-register-method',
-`dbus-register-property' or `dbus-register-signal' call. It
-returns t if OBJECT has been unregistered, nil otherwise.
+`dbus-register-signal', `dbus-register-property' or
+`dbus-register-monitor' call. The function returns t if OBJECT
+has been unregistered, nil otherwise.
When OBJECT identifies the last method or property, which is
registered for the respective service, Emacs releases its
@@ -859,7 +952,10 @@ association to the service from D-Bus."
(when (eq type :signal)
(dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "RemoveMatch" (nth 4 elt)))))
+ "RemoveMatch" (nth 4 elt)))
+ ;; Delete monitor connection by reestablishing private bus.
+ (when (eq type :monitor)
+ (dbus-init-bus bus 'private))))
;; Check, whether there is still a registered function or property
;; for the given service. If not, unregister the service from the
@@ -869,16 +965,19 @@ association to the service from D-Bus."
(progn
(maphash
(lambda (k v)
- (dolist (e v)
- (ignore-errors
- (and
- ;; Bus.
- (equal bus (cadr k))
- ;; Service.
- (string-equal service (cadr e))
- ;; Non-empty object path.
- (nth 2 e)
- (throw :found t)))))
+ (when (consp v)
+ (dolist (e v)
+ (ignore-errors
+ (and
+ ;; Type.
+ (eq type (car k))
+ ;; Bus.
+ (equal bus (cadr k))
+ ;; Service.
+ (string-equal service (cadr e))
+ ;; Non-empty object path.
+ (nth 2 e)
+ (throw :found t))))))
dbus-registered-objects-table)
nil))))
(dbus-unregister-service bus service))
@@ -893,9 +992,7 @@ association to the service from D-Bus."
STRING shall be UTF-8 coded."
(if (zerop (length string))
'(:array :signature "y")
- (let (result)
- (dolist (elt (string-to-list string) (append '(:array) result))
- (setq result (append result (list :byte elt)))))))
+ (cons :array (mapcan (lambda (c) (list :byte c)) string))))
(defun dbus-byte-array-to-string (byte-array &optional multibyte)
"Transform BYTE-ARRAY into UTF-8 coded string.
@@ -903,12 +1000,9 @@ BYTE-ARRAY must be a list of structure (c1 c2 ...), or a byte
array as produced by `dbus-string-to-byte-array'. The resulting
string is unibyte encoded, unless MULTIBYTE is non-nil."
(apply
- (if multibyte 'string 'unibyte-string)
- (if (equal byte-array '(:array :signature "y"))
- nil
- (let (result)
- (dolist (elt byte-array result)
- (when (characterp elt) (setq result (append result `(,elt)))))))))
+ (if multibyte #'string #'unibyte-string)
+ (unless (equal byte-array '(:array :signature "y"))
+ (seq-filter #'characterp byte-array))))
(defun dbus-escape-as-identifier (string)
"Escape an arbitrary STRING so it follows the rules for a C identifier.
@@ -930,9 +1024,9 @@ telepathy-glib's `tp_escape_as_identifier'."
(if (zerop (length string))
"_"
(replace-regexp-in-string
- "^[0-9]\\|[^A-Za-z0-9]"
+ "\\`[0-9]\\|[^A-Za-z0-9]"
(lambda (x) (format "_%2x" (aref x 0)))
- string)))
+ string nil t)))
(defun dbus-unescape-from-identifier (string)
"Retrieve the original string from the encoded STRING as unibyte string.
@@ -942,7 +1036,7 @@ STRING must have been encoded with `dbus-escape-as-identifier'."
(replace-regexp-in-string
"_.."
(lambda (x) (byte-to-string (string-to-number (substring x 1) 16)))
- string)))
+ string nil t)))
;;; D-Bus events.
@@ -951,26 +1045,37 @@ STRING must have been encoded with `dbus-escape-as-identifier'."
"Check whether EVENT is a well formed D-Bus event.
EVENT is a list which starts with symbol `dbus-event':
- (dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS)
+ (dbus-event BUS TYPE SERIAL SERVICE DESTINATION PATH
+ INTERFACE MEMBER HANDLER &rest ARGS)
BUS identifies the D-Bus the message is coming from. It is
-either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. TYPE is the D-Bus message type which
-has caused the event, SERIAL is the serial number of the received
-D-Bus message. SERVICE and PATH are the unique name and the
-object path of the D-Bus object emitting the message. INTERFACE
-and MEMBER denote the message which has been sent. HANDLER is
-the function which has been registered for this message. ARGS
-are the arguments passed to HANDLER, when it is called during
-event handling in `dbus-handle-event'.
+either a Lisp keyword, `:system', `:session', `:systemp-private'
+or `:session-private', or a string denoting the bus address.
+
+TYPE is the D-Bus message type which has caused the event, SERIAL
+is the serial number of the received D-Bus message when TYPE is
+equal `dbus-message-type-method-return' or `dbus-message-type-error'.
+
+SERVICE and PATH are the unique name and the object path of the
+D-Bus object emitting the message. DESTINATION is the D-Bus name
+the message is dedicated to, or nil in case the message is a
+broadcast signal.
+
+INTERFACE and MEMBER denote the message which has been sent.
+When TYPE is `dbus-message-type-error', MEMBER is the error name.
+
+HANDLER is the function which has been registered for this
+message. ARGS are the typed arguments as returned from the
+message. They are passed to HANDLER without type information,
+when it is called during event handling in `dbus-handle-event'.
This function signals a `dbus-error' if the event is not well
formed."
(when dbus-debug (message "DBus-Event %s" event))
(unless (and (listp event)
(eq (car event) 'dbus-event)
- ;; Bus symbol.
- (or (symbolp (nth 1 event))
+ ;; Bus keyword.
+ (or (keywordp (nth 1 event))
(stringp (nth 1 event)))
;; Type.
(and (natnump (nth 2 event))
@@ -982,54 +1087,103 @@ formed."
(= dbus-message-type-error (nth 2 event))
(or (stringp (nth 4 event))
(null (nth 4 event))))
- ;; Object path.
+ ;; Destination.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
- (stringp (nth 5 event)))
- ;; Interface.
+ (or (stringp (nth 5 event))
+ (null (nth 5 event))))
+ ;; Object path.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
(stringp (nth 6 event)))
- ;; Member.
+ ;; Interface.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
(stringp (nth 7 event)))
+ ;; Member.
+ (or (= dbus-message-type-method-return (nth 2 event))
+ (stringp (nth 8 event)))
;; Handler.
- (functionp (nth 8 event)))
+ (functionp (nth 9 event))
+ ;; Arguments.
+ (listp (nthcdr 10 event)))
(signal 'dbus-error (list "Not a valid D-Bus event" event))))
+(defun dbus-delete-types (&rest args)
+ "Delete type information from arguments retrieved via `dbus-handle-event'.
+Basic type arguments (TYPE VALUE) will be transformed into VALUE, and
+compound type arguments (TYPE VALUE) will be transformed into (VALUE)."
+ (car
+ (mapcar
+ (lambda (elt)
+ (cond
+ ((atom elt) elt)
+ ((memq (car elt) dbus-compound-types)
+ (mapcar #'dbus-delete-types (cdr elt)))
+ (t (cadr elt))))
+ args)))
+
+(defun dbus-flatten-types (arg)
+ "Flatten type information from argument retrieved via `dbus-handle-event'.
+Basic type arguments (TYPE VALUE) will be transformed into TYPE VALUE, and
+compound type arguments (TYPE VALUE) will be kept as is."
+ (let (result)
+ (dolist (elt arg)
+ (cond
+ ((atom elt) (push elt result))
+ ((and (not (memq (car elt) dbus-compound-types)))
+ (push (car elt) result)
+ (push (cadr elt) result))
+ (t
+ (push (cons (car elt) (dbus-flatten-types (cdr elt))) result))))
+ (nreverse result)))
+
;;;###autoload
(defun dbus-handle-event (event)
"Handle events from the D-Bus.
EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being
-part of the event, is called with arguments ARGS.
+part of the event, is called with arguments ARGS (without type information).
If the HANDLER returns a `dbus-error', it is propagated as return message."
(interactive "e")
(condition-case err
- (let (result)
+ (let (monitor args result)
;; We ignore not well-formed events.
(dbus-check-event event)
- ;; Error messages must be propagated.
- (when (= dbus-message-type-error (nth 2 event))
- (signal 'dbus-error (nthcdr 9 event)))
- ;; Apply the handler.
- (setq result (apply (nth 8 event) (nthcdr 9 event)))
- ;; Return a message when it is a message call.
- (when (= dbus-message-type-method-call (nth 2 event))
- (dbus-ignore-errors
- (if (eq result :ignore)
- (dbus-method-return-internal
- (nth 1 event) (nth 4 event) (nth 3 event))
- (apply 'dbus-method-return-internal
- (nth 1 event) (nth 4 event) (nth 3 event)
- (if (consp result) result (list result)))))))
+ ;; Remove type information.
+ (setq args (mapcar #'dbus-delete-types (nthcdr 10 event)))
+ (setq monitor
+ (gethash
+ (list :monitor (nth 1 event)) dbus-registered-objects-table))
+ (if monitor
+ ;; A monitor event shall not trigger other operations, and
+ ;; it shall not trigger D-Bus errors.
+ (setq result (dbus-ignore-errors (apply (nth 9 event) args)))
+ ;; Error messages must be propagated. The error name is in
+ ;; the member slot.
+ (when (= dbus-message-type-error (nth 2 event))
+ (signal 'dbus-error (cons (nth 8 event) args)))
+ ;; Apply the handler.
+ (setq result (apply (nth 9 event) args))
+ ;; Return an (error) message when it is a message call.
+ (when (= dbus-message-type-method-call (nth 2 event))
+ (dbus-ignore-errors
+ (if (eq (car-safe result) :error)
+ (apply #'dbus-method-error-internal
+ (nth 1 event) (nth 4 event) (nth 3 event) (cdr result))
+ (if (eq result :ignore)
+ (dbus-method-return-internal
+ (nth 1 event) (nth 4 event) (nth 3 event))
+ (apply #'dbus-method-return-internal
+ (nth 1 event) (nth 4 event) (nth 3 event)
+ (if (consp result) result (list result)))))))))
;; Error handling.
(dbus-error
;; Return an error message when it is a message call.
(when (= dbus-message-type-method-call (nth 2 event))
(dbus-ignore-errors
(dbus-method-error-internal
- (nth 1 event) (nth 4 event) (nth 3 event) (cadr err))))
+ (nth 1 event) (nth 4 event) (nth 3 event) dbus-error-failed
+ (error-message-string err))))
;; Propagate D-Bus error messages.
(run-hook-with-args 'dbus-event-error-functions event err)
(when dbus-debug
@@ -1037,8 +1191,8 @@ If the HANDLER returns a `dbus-error', it is propagated as return message."
(defun dbus-event-bus-name (event)
"Return the bus name the event is coming from.
-The result is either a Lisp symbol, `:system' or `:session', or a
-string denoting the bus address. EVENT is a D-Bus event, see
+The result is either a Lisp keyword, `:system' or `:session', or
+a string denoting the bus address. EVENT is a D-Bus event, see
`dbus-check-event'. This function signals a `dbus-error' if the
event is not well formed."
(dbus-check-event event)
@@ -1069,13 +1223,21 @@ formed."
(dbus-check-event event)
(nth 4 event))
+(defun dbus-event-destination-name (event)
+ "Return the name of the D-Bus object the event is dedicated to.
+The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
+This function signals a `dbus-error' if the event is not well
+formed."
+ (dbus-check-event event)
+ (nth 5 event))
+
(defun dbus-event-path-name (event)
"Return the object path of the D-Bus object the event is coming from.
The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
This function signals a `dbus-error' if the event is not well
formed."
(dbus-check-event event)
- (nth 5 event))
+ (nth 6 event))
(defun dbus-event-interface-name (event)
"Return the interface name of the D-Bus object the event is coming from.
@@ -1083,15 +1245,32 @@ The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
This function signals a `dbus-error' if the event is not well
formed."
(dbus-check-event event)
- (nth 6 event))
+ (nth 7 event))
(defun dbus-event-member-name (event)
"Return the member name the event is coming from.
-It is either a signal name or a method name. The result is a
-string. EVENT is a D-Bus event, see `dbus-check-event'. This
-function signals a `dbus-error' if the event is not well formed."
+It is either a signal name, a method name or an error name. The
+result is a string. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
(dbus-check-event event)
- (nth 7 event))
+ (nth 8 event))
+
+(defun dbus-event-handler (event)
+ "Return the handler the event is applied with.
+The result is a function. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
+ (dbus-check-event event)
+ (nth 9 event))
+
+(defun dbus-event-arguments (event)
+ "Return the arguments the event is carrying on.
+The result is a list of arguments. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
+ (dbus-check-event event)
+ (nthcdr 10 event))
;;; D-Bus registered names.
@@ -1101,10 +1280,11 @@ function signals a `dbus-error' if the event is not well formed."
BUS defaults to `:system' when nil or omitted. The result is a
list of strings, which is nil when there are no activatable
service names at all."
- (dbus-ignore-errors
- (dbus-call-method
- (or bus :system) dbus-service-dbus
- dbus-path-dbus dbus-interface-dbus "ListActivatableNames")))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ (or bus :system) dbus-service-dbus
+ dbus-path-dbus dbus-interface-dbus "ListActivatableNames"))))
(defun dbus-list-names (bus)
"Return the service names registered at D-Bus BUS.
@@ -1112,34 +1292,36 @@ The result is a list of strings, which is nil when there are no
registered service names at all. Well known names are strings
like \"org.freedesktop.DBus\". Names starting with \":\" are
unique names for services."
- (dbus-ignore-errors
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames")))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames"))))
(defun dbus-list-known-names (bus)
"Retrieve all services which correspond to a known name in BUS.
A service has a known name if it doesn't start with \":\"."
- (let (result)
- (dolist (name (dbus-list-names bus) (nreverse result))
- (unless (string-equal ":" (substring name 0 1))
- (push name result)))))
+ (seq-remove (lambda (name)
+ (= (string-to-char name) ?:))
+ (dbus-list-names bus)))
(defun dbus-list-queued-owners (bus service)
"Return the unique names registered at D-Bus BUS and queued for SERVICE.
The result is a list of strings, or nil when there are no queued
name owner service names at all."
- (dbus-ignore-errors
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus
- dbus-interface-dbus "ListQueuedOwners" service)))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus
+ dbus-interface-dbus "ListQueuedOwners" service))))
(defun dbus-get-name-owner (bus service)
"Return the name owner of SERVICE registered at D-Bus BUS.
The result is either a string, or nil if there is no name owner."
- (dbus-ignore-errors
- (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus
- dbus-interface-dbus "GetNameOwner" service)))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus
+ dbus-interface-dbus "GetNameOwner" service))))
(defun dbus-ping (bus service &optional timeout)
"Check whether SERVICE is registered for D-Bus BUS.
@@ -1167,7 +1349,8 @@ check whether SERVICE is already running, you can instead write
"Default handler for the \"org.freedesktop.DBus.Peer\" interface.
It will be registered for all objects created by `dbus-register-service'."
(let* ((last-input-event last-input-event)
- (method (dbus-event-member-name last-input-event)))
+ (method (dbus-event-member-name last-input-event))
+ (path (dbus-event-path-name last-input-event)))
(cond
;; "Ping" does not return an output parameter.
((string-equal method "Ping")
@@ -1177,37 +1360,62 @@ It will be registered for all objects created by `dbus-register-service'."
(signal
'dbus-error
(list
- (format "%s.GetMachineId not implemented" dbus-interface-peer)))))))
+ (format "%s.GetMachineId not implemented" dbus-interface-peer))))
+ (t `(:error ,dbus-error-unknown-method
+ ,(format-message
+ "No such method \"%s.%s\" at path \"%s\""
+ dbus-interface-peer method path))))))
;;; D-Bus introspection.
+(defsubst dbus--introspect-names (object tag)
+ "Return the names of the children of OBJECT with TAG."
+ (mapcar (lambda (elt)
+ (dbus-introspect-get-attribute elt "name"))
+ (xml-get-children object tag)))
+
+(defsubst dbus--introspect-name (object tag name)
+ "Return the first child of OBJECT with TAG, whose name is NAME."
+ (seq-find (lambda (elt)
+ (string-equal (dbus-introspect-get-attribute elt "name") name))
+ (xml-get-children object tag)))
+
(defun dbus-introspect (bus service path)
"Return all interfaces and sub-nodes of SERVICE,
registered at object path PATH at bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. SERVICE must be a known service name,
-and PATH must be a valid object path. The last two parameters
-are strings. The result, the introspection data, is a string in
-XML format."
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. SERVICE must be a known service
+name, and PATH must be a valid object path. The last two
+parameters are strings. The result, the introspection data, is a
+string in XML format."
;; We don't want to raise errors.
- (dbus-ignore-errors
- (dbus-call-method
- bus service path dbus-interface-introspectable "Introspect"
- :timeout 1000)))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus service path dbus-interface-introspectable "Introspect"
+ :timeout 1000))))
+
+(defalias 'dbus--parse-xml-buffer
+ (if (libxml-available-p)
+ (lambda ()
+ (xml-remove-comments (point-min) (point-max))
+ (libxml-parse-xml-region (point-min) (point-max)))
+ (lambda ()
+ (car (xml-parse-region (point-min) (point-max)))))
+ "Compatibility shim for `libxml-parse-xml-region'.")
(defun dbus-introspect-xml (bus service path)
"Return the introspection data of SERVICE in D-Bus BUS at object path PATH.
The data are a parsed list. The root object is a \"node\",
representing the object path PATH. The root object can contain
\"interface\" and further \"node\" objects."
- ;; We don't want to raise errors.
- (xml-node-name
- (ignore-errors
- (with-temp-buffer
- (insert (dbus-introspect bus service path))
- (xml-parse-region (point-min) (point-max))))))
+ (with-temp-buffer
+ ;; We don't want to raise errors.
+ (ignore-errors
+ (insert (dbus-introspect bus service path))
+ (dbus--parse-xml-buffer))))
(defun dbus-introspect-get-attribute (object attribute)
"Return the ATTRIBUTE value of D-Bus introspection OBJECT.
@@ -1219,21 +1427,15 @@ the D-Bus specification."
"Return all node names of SERVICE in D-Bus BUS at object path PATH.
It returns a list of strings. The node names stand for further
object paths of the D-Bus service."
- (let ((object (dbus-introspect-xml bus service path))
- result)
- (dolist (elt (xml-get-children object 'node) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names (dbus-introspect-xml bus service path) 'node))
(defun dbus-introspect-get-all-nodes (bus service path)
"Return all node names of SERVICE in D-Bus BUS at object path PATH.
It returns a list of strings, which are further object paths of SERVICE."
- (let ((result (list path)))
- (dolist (elt
- (dbus-introspect-get-node-names bus service path)
- result)
- (setq elt (expand-file-name elt path))
- (setq result
- (append result (dbus-introspect-get-all-nodes bus service elt))))))
+ (cons path (mapcan (lambda (elt)
+ (setq elt (expand-file-name elt path))
+ (dbus-introspect-get-all-nodes bus service elt))
+ (dbus-introspect-get-node-names bus service path))))
(defun dbus-introspect-get-interface-names (bus service path)
"Return all interface names of SERVICE in D-Bus BUS at object path PATH.
@@ -1244,10 +1446,7 @@ always present. Another default interface is
\"org.freedesktop.DBus.Properties\". If present, \"interface\"
objects can also have \"property\" objects as children, beside
\"method\" and \"signal\" objects."
- (let ((object (dbus-introspect-xml bus service path))
- result)
- (dolist (elt (xml-get-children object 'interface) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names (dbus-introspect-xml bus service path) 'interface))
(defun dbus-introspect-get-interface (bus service path interface)
"Return the INTERFACE of SERVICE in D-Bus BUS at object path PATH.
@@ -1256,22 +1455,14 @@ and a member of the list returned by
`dbus-introspect-get-interface-names'. The resulting
\"interface\" object can contain \"method\", \"signal\",
\"property\" and \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-xml bus service path) 'interface)))
- (while (and elt
- (not (string-equal
- interface
- (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name (dbus-introspect-xml bus service path)
+ 'interface interface))
(defun dbus-introspect-get-method-names (bus service path interface)
"Return a list of strings of all method names of INTERFACE.
SERVICE is a service of D-Bus BUS at object path PATH."
- (let ((object (dbus-introspect-get-interface bus service path interface))
- result)
- (dolist (elt (xml-get-children object 'method) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (dbus-introspect-get-interface bus service path interface) 'method))
(defun dbus-introspect-get-method (bus service path interface method)
"Return method METHOD of interface INTERFACE as an XML object.
@@ -1279,22 +1470,15 @@ It must be located at SERVICE in D-Bus BUS at object path PATH.
METHOD must be a string and a member of the list returned by
`dbus-introspect-get-method-names'. The resulting \"method\"
object can contain \"arg\" and \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-get-interface bus service path interface)
- 'method)))
- (while (and elt
- (not (string-equal
- method (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (dbus-introspect-get-interface bus service path interface)
+ 'method method))
(defun dbus-introspect-get-signal-names (bus service path interface)
"Return a list of strings of all signal names of INTERFACE.
SERVICE is a service of D-Bus BUS at object path PATH."
- (let ((object (dbus-introspect-get-interface bus service path interface))
- result)
- (dolist (elt (xml-get-children object 'signal) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (dbus-introspect-get-interface bus service path interface) 'signal))
(defun dbus-introspect-get-signal (bus service path interface signal)
"Return signal SIGNAL of interface INTERFACE as an XML object.
@@ -1302,22 +1486,15 @@ It must be located at SERVICE in D-Bus BUS at object path PATH.
SIGNAL must be a string, element of the list returned by
`dbus-introspect-get-signal-names'. The resulting \"signal\"
object can contain \"arg\" and \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-get-interface bus service path interface)
- 'signal)))
- (while (and elt
- (not (string-equal
- signal (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (dbus-introspect-get-interface bus service path interface)
+ 'signal signal))
(defun dbus-introspect-get-property-names (bus service path interface)
"Return a list of strings of all property names of INTERFACE.
SERVICE is a service of D-Bus BUS at object path PATH."
- (let ((object (dbus-introspect-get-interface bus service path interface))
- result)
- (dolist (elt (xml-get-children object 'property) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (dbus-introspect-get-interface bus service path interface) 'property))
(defun dbus-introspect-get-property (bus service path interface property)
"Return PROPERTY of INTERFACE as an XML object.
@@ -1325,15 +1502,9 @@ It must be located at SERVICE in D-Bus BUS at object path PATH.
PROPERTY must be a string and a member of the list returned by
`dbus-introspect-get-property-names'. The resulting PROPERTY
object can contain \"annotation\" children."
- (let ((elt (xml-get-children
- (dbus-introspect-get-interface bus service path interface)
- 'property)))
- (while (and elt
- (not (string-equal
- property
- (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (dbus-introspect-get-interface bus service path interface)
+ 'property property))
(defun dbus-introspect-get-annotation-names
(bus service path interface &optional name)
@@ -1341,15 +1512,13 @@ object can contain \"annotation\" children."
If NAME is nil, the annotations are children of INTERFACE,
otherwise NAME must be a \"method\", \"signal\", or \"property\"
object, where the annotations belong to."
- (let ((object
- (if name
- (or (dbus-introspect-get-method bus service path interface name)
- (dbus-introspect-get-signal bus service path interface name)
- (dbus-introspect-get-property bus service path interface name))
- (dbus-introspect-get-interface bus service path interface)))
- result)
- (dolist (elt (xml-get-children object 'annotation) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (if name
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name)
+ (dbus-introspect-get-property bus service path interface name))
+ (dbus-introspect-get-interface bus service path interface))
+ 'annotation))
(defun dbus-introspect-get-annotation
(bus service path interface name annotation)
@@ -1357,22 +1526,13 @@ object, where the annotations belong to."
If NAME is nil, ANNOTATION is a child of INTERFACE, otherwise
NAME must be the name of a \"method\", \"signal\", or
\"property\" object, where the ANNOTATION belongs to."
- (let ((elt (xml-get-children
- (if name
- (or (dbus-introspect-get-method
- bus service path interface name)
- (dbus-introspect-get-signal
- bus service path interface name)
- (dbus-introspect-get-property
- bus service path interface name))
- (dbus-introspect-get-interface bus service path interface))
- 'annotation)))
- (while (and elt
- (not (string-equal
- annotation
- (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (if name
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name)
+ (dbus-introspect-get-property bus service path interface name))
+ (dbus-introspect-get-interface bus service path interface))
+ 'annotation annotation))
(defun dbus-introspect-get-argument-names (bus service path interface name)
"Return a list of all argument names as a list of strings.
@@ -1380,61 +1540,55 @@ NAME must be a \"method\" or \"signal\" object.
Argument names are optional, the function can return nil
therefore, even if the method or signal has arguments."
- (let ((object
- (or (dbus-introspect-get-method bus service path interface name)
- (dbus-introspect-get-signal bus service path interface name)))
- result)
- (dolist (elt (xml-get-children object 'arg) (nreverse result))
- (push (dbus-introspect-get-attribute elt "name") result))))
+ (dbus--introspect-names
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name))
+ 'arg))
(defun dbus-introspect-get-argument (bus service path interface name arg)
"Return argument ARG as XML object.
NAME must be a \"method\" or \"signal\" object. ARG must be a
string and a member of the list returned by
`dbus-introspect-get-argument-names'."
- (let ((elt (xml-get-children
- (or (dbus-introspect-get-method bus service path interface name)
- (dbus-introspect-get-signal bus service path interface name))
- 'arg)))
- (while (and elt
- (not (string-equal
- arg (dbus-introspect-get-attribute (car elt) "name"))))
- (setq elt (cdr elt)))
- (car elt)))
+ (dbus--introspect-name
+ (or (dbus-introspect-get-method bus service path interface name)
+ (dbus-introspect-get-signal bus service path interface name))
+ 'arg arg))
(defun dbus-introspect-get-signature
(bus service path interface name &optional direction)
- "Return signature of a `method' or `signal' represented by NAME as a string.
+ "Return signature of a `method', `property' or `signal' represented by NAME.
If NAME is a `method', DIRECTION can be either \"in\" or \"out\".
If DIRECTION is nil, \"in\" is assumed.
-If NAME is a `signal', and DIRECTION is non-nil, DIRECTION must
-be \"out\"."
+If NAME is a `signal' or a `property', DIRECTION is ignored."
;; For methods, we use "in" as default direction.
(let ((object (or (dbus-introspect-get-method
bus service path interface name)
(dbus-introspect-get-signal
+ bus service path interface name)
+ (dbus-introspect-get-property
bus service path interface name))))
- (when (and (string-equal
- "method" (dbus-introspect-get-attribute object "name"))
- (not (stringp direction)))
+ (when (and (eq 'method (car object)) (not (stringp direction)))
(setq direction "in"))
;; In signals, no direction is given.
- (when (string-equal "signal" (dbus-introspect-get-attribute object "name"))
+ (when (eq 'signal (car object))
(setq direction nil))
;; Collect the signatures.
- (mapconcat
- (lambda (x)
- (let ((arg (dbus-introspect-get-argument
- bus service path interface name x)))
- (if (or (not (stringp direction))
- (string-equal
- direction
- (dbus-introspect-get-attribute arg "direction")))
- (dbus-introspect-get-attribute arg "type")
- "")))
- (dbus-introspect-get-argument-names bus service path interface name)
- "")))
+ (if (eq 'property (car object))
+ (dbus-introspect-get-attribute object "type")
+ (mapconcat
+ (lambda (x)
+ (let ((arg (dbus-introspect-get-argument
+ bus service path interface name x)))
+ (if (or (not (stringp direction))
+ (string-equal
+ direction
+ (dbus-introspect-get-attribute arg "direction")))
+ (dbus-introspect-get-attribute arg "type")
+ "")))
+ (dbus-introspect-get-argument-names bus service path interface name)
+ ""))))
;;; D-Bus properties.
@@ -1442,52 +1596,58 @@ be \"out\"."
(defun dbus-get-property (bus service path interface property)
"Return the value of PROPERTY of INTERFACE.
It will be checked at BUS, SERVICE, PATH. The result can be any
-valid D-Bus value, or nil if there is no PROPERTY."
- (dbus-ignore-errors
- ;; "Get" returns a variant, so we must use the `car'.
- (car
- (dbus-call-method
- bus service path dbus-interface-properties
- "Get" :timeout 500 interface property))))
-
-(defun dbus-set-property (bus service path interface property value)
- "Set value of PROPERTY of INTERFACE to VALUE.
-It will be checked at BUS, SERVICE, PATH. When the value is
-successfully set return VALUE. Otherwise, return nil."
- (dbus-ignore-errors
- ;; "Set" requires a variant.
+valid D-Bus value, or nil if there is no PROPERTY, or PROPERTY cannot be read."
+ ;; "Get" returns a variant, so we must use the `car'.
+ (car
(dbus-call-method
bus service path dbus-interface-properties
- "Set" :timeout 500 interface property (list :variant value))
- ;; Return VALUE.
- (dbus-get-property bus service path interface property)))
+ "Get" :timeout 500 interface property)))
+
+(defun dbus-set-property (bus service path interface property &rest args)
+ "Set value of PROPERTY of INTERFACE to VALUE.
+It will be checked at BUS, SERVICE, PATH. VALUE can be preceded
+by a TYPE keyword. When the value is successfully set, and the
+property's access type is not `:write', return VALUE. Otherwise,
+return nil.
+
+\(dbus-set-property BUS SERVICE PATH INTERFACE PROPERTY [TYPE] VALUE)"
+ ;; "Set" requires a variant.
+ (dbus-call-method
+ bus service path dbus-interface-properties
+ "Set" :timeout 500 interface property (cons :variant args))
+ ;; Return VALUE.
+ (condition-case err
+ (dbus-get-property bus service path interface property)
+ (dbus-error
+ (if (string-equal dbus-error-access-denied (cadr err))
+ (car args)
+ (signal (car err) (cdr err))))))
(defun dbus-get-all-properties (bus service path interface)
"Return all properties of INTERFACE at BUS, SERVICE, PATH.
The result is a list of entries. Every entry is a cons of the
name of the property, and its value. If there are no properties,
nil is returned."
- (dbus-ignore-errors
- ;; "GetAll" returns "a{sv}".
- (let (result)
- (dolist (dict
- (dbus-call-method
- bus service path dbus-interface-properties
- "GetAll" :timeout 500 interface)
- (nreverse result))
- (push (cons (car dict) (cl-caadr dict)) result)))))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ ;; "GetAll" returns "a{sv}".
+ (mapcar (lambda (dict)
+ (cons (car dict) (caadr dict)))
+ (dbus-call-method bus service path dbus-interface-properties
+ "GetAll" :timeout 500 interface)))))
(defun dbus-get-this-registered-property (bus _service path interface property)
"Return PROPERTY entry of `dbus-registered-objects-table'.
Filter out not matching PATH."
;; Remove entries not belonging to this case.
- (seq-remove
+ (seq-filter
(lambda (item)
- (not (string-equal path (nth 2 item))))
+ (string-equal path (nth 2 item)))
(gethash (list :property bus interface property)
dbus-registered-objects-table)))
-(defun dbus-get-other-registered-property (bus _service path interface property)
+(defun dbus-get-other-registered-properties
+ (bus _service path interface property)
"Return PROPERTY entry of `dbus-registered-objects-table'.
Filter out matching PATH."
;; Remove matching entries.
@@ -1498,12 +1658,11 @@ Filter out matching PATH."
dbus-registered-objects-table)))
(defun dbus-register-property
- (bus service path interface property access value
- &optional emits-signal dont-register-service)
+ (bus service path interface property access &rest args)
"Register PROPERTY on the D-Bus BUS.
-BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
SERVICE is the D-Bus service name of the D-Bus. It must be a
known name (see discussion of DONT-REGISTER-SERVICE below).
@@ -1513,14 +1672,16 @@ discussion of DONT-REGISTER-SERVICE below). INTERFACE is the
name of the interface used at PATH, PROPERTY is the name of the
property of INTERFACE. ACCESS indicates, whether the property
can be changed by other services via D-Bus. It must be either
-the symbol `:read' or `:readwrite'. VALUE is the initial value
-of the property, it can be of any valid type (see
-`dbus-call-method' for details).
+the keyword `:read', `:write' or `:readwrite'.
+
+VALUE is the initial value of the property, it can be of any
+valid type (see `dbus-call-method' for details). VALUE can be
+preceded by a TYPE keyword.
If PROPERTY already exists on PATH, it will be overwritten. For
properties with access type `:read' this is the only way to
-change their values. Properties with access type `:readwrite'
-can be changed by `dbus-set-property'.
+change their values. Properties with access type `:write' or
+`:readwrite' can be changed by `dbus-set-property'.
The interface \"org.freedesktop.DBus.Properties\" is added to
PATH, including a default handler for the \"Get\", \"GetAll\" and
@@ -1533,116 +1694,167 @@ not registered. This means that other D-Bus clients have no way
of noticing the newly registered property. When interfaces are
constructed incrementally by adding single methods or properties
at a time, DONT-REGISTER-SERVICE can be used to prevent other
-clients from discovering the still incomplete interface."
- (unless (member access '(:read :readwrite))
- (signal 'wrong-type-argument (list "Access type invalid" access)))
-
- ;; Add handlers for the three property-related methods.
- (dbus-register-method
- bus service path dbus-interface-properties "Get"
- 'dbus-property-handler 'dont-register)
- (dbus-register-method
- bus service path dbus-interface-properties "GetAll"
- 'dbus-property-handler 'dont-register)
- (dbus-register-method
- bus service path dbus-interface-properties "Set"
- 'dbus-property-handler 'dont-register)
-
- ;; Register SERVICE.
- (unless (or dont-register-service (member service (dbus-list-names bus)))
- (dbus-register-service bus service))
-
- ;; Send the PropertiesChanged signal.
- (when emits-signal
- (dbus-send-signal
- bus service path dbus-interface-properties "PropertiesChanged"
- `((:dict-entry ,property (:variant ,value)))
- '(:array)))
-
- ;; Create a hash table entry. We use nil for the unique name,
- ;; because the property might be accessed from anybody.
- (let ((key (list :property bus interface property))
- (val
- (cons
- (list
- nil service path
- (cons
- (if emits-signal (list access :emits-signal) (list access))
- value))
- (dbus-get-other-registered-property
- bus service path interface property))))
- (puthash key val dbus-registered-objects-table)
-
- ;; Return the object.
- (list key (list service path))))
+clients from discovering the still incomplete interface.
+
+\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \
+[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)"
+ (let (;; Read basic type keyword.
+ (type (when (keywordp (car args)) (pop args)))
+ (value (pop args))
+ (emits-signal (pop args))
+ (dont-register-service (pop args)))
+ (unless (member access '(:read :write :readwrite))
+ (signal 'wrong-type-argument (list "Access type invalid" access)))
+ (unless (or type (consp value))
+ (setq type
+ (cond
+ ((memq value '(t nil)) :boolean)
+ ((natnump value) :uint32)
+ ((fixnump value) :int32)
+ ((floatp value) :double)
+ ((stringp value) :string)
+ (t
+ (signal 'wrong-type-argument (list "Value type invalid" value))))))
+ (unless (consp value)
+ (setq value (list type value)))
+ (setq value (if (member (car value) dbus-compound-types)
+ (list :variant value) (cons :variant value)))
+ (dbus-check-arguments bus service value)
+
+ ;; Add handlers for the three property-related methods.
+ (dbus-register-method
+ bus service path dbus-interface-properties "Get"
+ #'dbus-property-handler 'dont-register)
+ (dbus-register-method
+ bus service path dbus-interface-properties "GetAll"
+ #'dbus-property-handler 'dont-register)
+ (dbus-register-method
+ bus service path dbus-interface-properties "Set"
+ #'dbus-property-handler 'dont-register)
+
+ ;; Register SERVICE.
+ (unless (or dont-register-service (member service (dbus-list-names bus)))
+ (dbus-register-service bus service))
+
+ ;; Send the PropertiesChanged signal.
+ (when emits-signal
+ (dbus-send-signal
+ bus service path dbus-interface-properties "PropertiesChanged"
+ interface
+ ;; changed_properties.
+ (if (eq access :write)
+ '(:array: :signature "{sv}")
+ `(:array (:dict-entry ,property ,value)))
+ ;; invalidated_properties.
+ (if (eq access :write)
+ `(:array ,property)
+ '(:array))))
+
+ ;; Create a hash table entry. We use nil for the unique name,
+ ;; because the property might be accessed from anybody.
+ (let ((key (list :property bus interface property))
+ (val
+ (cons
+ (list nil service path (list access emits-signal value))
+ (dbus-get-other-registered-properties
+ bus service path interface property))))
+ (puthash key val dbus-registered-objects-table)
+
+ ;; Return the object.
+ (list key (list service path)))))
(defun dbus-property-handler (&rest args)
"Default handler for the \"org.freedesktop.DBus.Properties\" interface.
It will be registered for all objects created by `dbus-register-property'."
- (let ((bus (dbus-event-bus-name last-input-event))
- (service (dbus-event-service-name last-input-event))
- (path (dbus-event-path-name last-input-event))
- (method (dbus-event-member-name last-input-event))
- (interface (car args))
- (property (cadr args)))
+ (let* ((last-input-event last-input-event)
+ (bus (dbus-event-bus-name last-input-event))
+ (service (dbus-event-service-name last-input-event))
+ (path (dbus-event-path-name last-input-event))
+ (method (dbus-event-member-name last-input-event))
+ (interface (car args))
+ (property (cadr args)))
(cond
;; "Get" returns a variant.
((string-equal method "Get")
- (let ((entry (dbus-get-this-registered-property
- bus service path interface property)))
- (when (string-equal path (nth 2 (car entry)))
- `((:variant ,(cdar (last (car entry))))))))
-
- ;; "Set" expects a variant.
+ (let* ((entry (dbus-get-this-registered-property
+ bus service path interface property))
+ (object (car (last (car entry)))))
+ (cond
+ ((not (consp object))
+ `(:error ,dbus-error-unknown-property
+ ,(format-message
+ "No such property \"%s\" at path \"%s\"" property path)))
+ ((eq :write (car object))
+ `(:error ,dbus-error-access-denied
+ ,(format-message
+ "Property \"%s\" at path \"%s\" is not readable" property path)))
+ ;; Return the result. Since variant is a list, we must embed
+ ;; it into another list.
+ (t (list (nth 2 object))))))
+
+ ;; "Set" needs the third typed argument from `last-input-event'.
((string-equal method "Set")
- (let* ((value (caar (cddr args)))
+ (let* ((value (dbus-flatten-types (nth 12 last-input-event)))
(entry (dbus-get-this-registered-property
bus service path interface property))
- ;; The value of the hash table is a list; in case of
- ;; properties it contains just one element (UNAME SERVICE
- ;; PATH OBJECT). OBJECT is a cons cell of a list, which
- ;; contains a list of annotations (like :read,
- ;; :read-write, :emits-signal), and the value of the
- ;; property.
(object (car (last (car entry)))))
- (unless (consp object)
- (signal 'dbus-error
- (list "Property not registered at path" property path)))
- (unless (member :readwrite (car object))
- (signal 'dbus-error
- (list "Property not writable at path" property path)))
- (puthash (list :property bus interface property)
- (cons (append (butlast (car entry))
- (list (cons (car object) value)))
- (dbus-get-other-registered-property
- bus service path interface property))
- dbus-registered-objects-table)
- ;; Send the "PropertiesChanged" signal.
- (when (member :emits-signal (car object))
- (dbus-send-signal
- bus service path dbus-interface-properties "PropertiesChanged"
- `((:dict-entry ,property (:variant ,value)))
- '(:array)))
- ;; Return empty reply.
- :ignore))
+ (cond
+ ((not (consp object))
+ `(:error ,dbus-error-unknown-property
+ ,(format-message
+ "No such property \"%s\" at path \"%s\"" property path)))
+ ((eq :read (car object))
+ `(:error ,dbus-error-property-read-only
+ ,(format-message
+ "Property \"%s\" at path \"%s\" is not writable" property path)))
+ (t (puthash (list :property bus interface property)
+ (cons (append
+ (butlast (car entry))
+ ;; Reuse ACCESS and EMITS-SIGNAL.
+ (list (append (butlast object) (list value))))
+ (dbus-get-other-registered-properties
+ bus service path interface property))
+ dbus-registered-objects-table)
+ ;; Send the "PropertiesChanged" signal.
+ (when (nth 1 object)
+ (dbus-send-signal
+ bus service path dbus-interface-properties "PropertiesChanged"
+ interface
+ ;; changed_properties.
+ (if (eq :write (car object))
+ '(:array: :signature "{sv}")
+ `(:array (:dict-entry ,property ,value)))
+ ;; invalidated_properties.
+ (if (eq :write (car object))
+ `(:array ,property)
+ '(:array))))
+ ;; Return empty reply.
+ :ignore))))
;; "GetAll" returns "a{sv}".
((string-equal method "GetAll")
(let (result)
(maphash
(lambda (key val)
- (dolist (item val)
- (when (and (equal (butlast key) (list :property bus interface))
- (string-equal path (nth 2 item))
- (not (functionp (car (last item)))))
- (push
- (list :dict-entry
- (car (last key))
- (list :variant (cdar (last item))))
- result))))
+ (when (consp val)
+ (dolist (item val)
+ (let ((object (car (last item))))
+ (when (and (equal (butlast key) (list :property bus interface))
+ (string-equal path (nth 2 item))
+ (consp object)
+ (not (eq :write (car object))))
+ (push
+ (list :dict-entry (car (last key)) (nth 2 object))
+ result))))))
dbus-registered-objects-table)
- ;; Return the result, or an empty array.
- (list :array (or result '(:signature "{sv}"))))))))
+ ;; Return the result, or an empty array. An array must be
+ ;; embedded in a list.
+ (list (cons :array (or result '(:signature "{sv}"))))))
+
+ (t `(:error ,dbus-error-unknown-method
+ ,(format-message
+ "No such method \"%s.%s\" at path \"%s\""
+ dbus-interface-properties method path))))))
;;; D-Bus object manager.
@@ -1682,10 +1894,11 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
(let ((result
;; Direct call. Fails, if the target does not support the
;; object manager interface.
- (dbus-ignore-errors
- (dbus-call-method
- bus service path dbus-interface-objectmanager
- "GetManagedObjects" :timeout 1000))))
+ (let (dbus-debug)
+ (dbus-ignore-errors
+ (dbus-call-method
+ bus service path dbus-interface-objectmanager
+ "GetManagedObjects" :timeout 1000)))))
(if result
;; Massage the returned structure.
@@ -1698,7 +1911,7 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
(if (cadr entry2)
;; "sv".
(dolist (entry3 (cadr entry2))
- (setcdr entry3 (cl-caadr entry3)))
+ (setcdr entry3 (caadr entry3)))
(setcdr entry2 nil)))))
;; Fallback: collect the information. Slooow!
@@ -1729,35 +1942,38 @@ It will be registered for all objects created by `dbus-register-service'."
;; Check for object path wildcard interfaces.
(maphash
(lambda (key val)
- (when (and (equal (butlast key 2) (list :method bus))
- (null (nth 2 (car-safe val))))
- (push (nth 2 key) interfaces)))
+ (when (equal (butlast key 2) (list :property bus))
+ (dolist (item val)
+ (unless (nth 2 item) ; Path.
+ (push (nth 2 key) interfaces)))))
dbus-registered-objects-table)
;; Check all registered object paths.
(maphash
(lambda (key val)
- (let ((object (or (nth 2 (car-safe val)) "")))
- (when (and (equal (butlast key 2) (list :method bus))
- (string-prefix-p path object))
- (dolist (interface (cons (nth 2 key) interfaces))
- (unless (assoc object result)
- (push (list object) result))
- (unless (assoc interface (cdr (assoc object result)))
- (setcdr
- (assoc object result)
- (append
- (list (cons
- interface
- ;; We simulate "org.freedesktop.DBus.Properties.GetAll"
- ;; by using an appropriate D-Bus event.
- (let ((last-input-event
- (append
- (butlast last-input-event 4)
- (list object dbus-interface-properties
- "GetAll" 'dbus-property-handler))))
- (dbus-property-handler interface))))
- (cdr (assoc object result)))))))))
+ (when (equal (butlast key 2) (list :property bus))
+ (dolist (item val)
+ (let ((object (or (nth 2 item) ""))) ; Path.
+ (when (string-prefix-p path object)
+ (dolist (interface (cons (nth 2 key) (delete-dups interfaces)))
+ (unless (assoc object result)
+ (push (list object) result))
+ (unless (assoc interface (cdr (assoc object result)))
+ (setcdr
+ (assoc object result)
+ (append
+ (list (cons
+ interface
+ ;; We simulate
+ ;; "org.freedesktop.DBus.Properties.GetAll"
+ ;; by using an appropriate D-Bus event.
+ (let ((last-input-event
+ (append
+ (butlast last-input-event 4)
+ (list object dbus-interface-properties
+ "GetAll" #'dbus-property-handler))))
+ (dbus-property-handler interface))))
+ (cdr (assoc object result)))))))))))
dbus-registered-objects-table)
;; Return the result, or an empty array.
@@ -1772,13 +1988,195 @@ It will be registered for all objects created by `dbus-register-service'."
result)
'(:signature "{oa{sa{sv}}}"))))))
+(cl-defun dbus-register-monitor
+ (bus &optional handler &key type sender destination path interface member)
+ "Register HANDLER for monitor events on the D-Bus BUS.
+
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address.
+
+HANDLER is the function to be called when a monitor event
+arrives. It is called with the `args' slot of the monitor event,
+which are stripped off the type keywords. If HANDLER is nil, the
+default handler `dbus-monitor-handler' is applied.
+
+The other arguments are keyword-value pairs. `:type TYPE'
+defines the message type to be monitored. If given, it must be
+equal one of the strings \"method_call\", \"method_return\",
+\"error\" or \"signal\".
+
+`:sender SENDER' and `:destination DESTINATION' are D-Bus names.
+They can be unique names, or well-known service names.
+
+`:path PATH' is the D-Bus object to be monitored. `:interface
+INTERFACE' is the name of an interface, and `:member MEMBER' is
+either a method name, a signal name, or an error name."
+ (let ((bus-private (if (eq bus :system) :system-private
+ (if (eq bus :session) :session-private bus)))
+ rule key key1 value)
+ (unless handler (setq handler #'dbus-monitor-handler))
+ ;; Compose rule.
+ (setq rule
+ (string-join
+ (delq nil (mapcar
+ (lambda (item)
+ (when (cdr item)
+ (format "%s='%s'" (car item) (cdr item))))
+ `(("type" . ,type) ("sender" . ,sender)
+ ("destination" . ,destination) ("path" . ,path)
+ ("interface" . ,interface) ("member" . ,member))))
+ ",")
+ rule (or rule ""))
+
+ (unless (ignore-errors (dbus-get-unique-name bus-private))
+ (dbus-init-bus bus 'private))
+ (dbus-call-method
+ bus-private dbus-service-dbus dbus-path-dbus dbus-interface-monitoring
+ "BecomeMonitor" `(:array :string ,rule) :uint32 0)
+
+ (when dbus-debug (message "Matching rule \"%s\" created" rule))
+
+ ;; Create a hash table entry.
+ (setq key (list :monitor bus-private)
+ key1 (list nil nil nil handler rule)
+ value (gethash key dbus-registered-objects-table))
+ (unless (member key1 value)
+ (puthash key (cons key1 value) dbus-registered-objects-table))
+
+ (when dbus-debug (message "%s" dbus-registered-objects-table))
+
+ ;; Return the object.
+ (list key (list nil nil handler))))
+
+(defconst dbus-monitor-method-call
+ (propertize "method-call" 'face 'font-lock-function-name-face)
+ "Text to be inserted for D-Bus method-call in monitor.")
+
+(defconst dbus-monitor-method-return
+ (propertize "method-return" 'face 'font-lock-function-name-face)
+ "Text to be inserted for D-Bus method-return in monitor.")
+
+(defconst dbus-monitor-error (propertize "error" 'face 'font-lock-warning-face)
+ "Text to be inserted for D-Bus error in monitor.")
+
+(defconst dbus-monitor-signal
+ (propertize "signal" 'face 'font-lock-type-face)
+ "Text to be inserted for D-Bus signal in monitor.")
+
+(defun dbus-monitor-goto-serial ()
+ "Goto D-Bus message with the same serial number."
+ (interactive)
+ (when (mouse-event-p last-input-event) (mouse-set-point last-input-event))
+ (when-let ((point (get-text-property (point) 'dbus-serial)))
+ (goto-char point)))
+
+(defun dbus-monitor-handler (&rest _args)
+ "Default handler for the \"org.freedesktop.DBus.Monitoring.BecomeMonitor\" interface.
+It will be applied for all objects created by `dbus-register-monitor'
+which don't declare an own handler. The printed timestamps do
+not reflect the time the D-Bus message has passed the D-Bus
+daemon, it is rather the timestamp the corresponding D-Bus event
+has been handled by this function."
+ (with-current-buffer (get-buffer-create "*D-Bus Monitor*")
+ (special-mode)
+ ;; Move forward and backward between messages.
+ (local-set-key [?n] #'forward-paragraph)
+ (local-set-key [?p] #'backward-paragraph)
+ ;; Follow serial links.
+ (local-set-key (kbd "RET") #'dbus-monitor-goto-serial)
+ (local-set-key [mouse-2] #'dbus-monitor-goto-serial)
+ (let* ((inhibit-read-only t)
+ (text-quoting-style 'grave)
+ (point (point))
+ (eobp (eobp))
+ (event last-input-event)
+ (type (dbus-event-message-type event))
+ (sender (dbus-event-service-name event))
+ (destination (dbus-event-destination-name event))
+ (serial (dbus-event-serial-number event))
+ (path (dbus-event-path-name event))
+ (interface (dbus-event-interface-name event))
+ (member (dbus-event-member-name event))
+ (arguments (dbus-event-arguments event))
+ (time (time-to-seconds (current-time))))
+ (save-excursion
+ ;; Check for matching method-call.
+ (goto-char (point-max))
+ (when (and (or (= type dbus-message-type-method-return)
+ (= type dbus-message-type-error))
+ (re-search-backward
+ (format
+ (concat
+ "^method-call time=\\(\\S-+\\) "
+ ".*sender=%s .*serial=\\(%d\\) ")
+ destination serial)
+ nil 'noerror))
+ (setq serial
+ (propertize
+ (match-string 2) 'dbus-serial (match-beginning 0)
+ 'help-echo "RET, mouse-1, mouse-2: goto method-call"
+ 'face 'link 'follow-link 'mouse-face 'mouse-face 'highlight)
+ time (format "%f (%f)" time (- time (read (match-string 1)))))
+ (set-text-properties
+ (match-beginning 2) (match-end 2)
+ `(dbus-serial ,(point-max)
+ help-echo
+ ,(format
+ "RET, mouse-1, mouse-2: goto %s"
+ (if (= type dbus-message-type-error) "error" "method-return"))
+ face link follow-link mouse-face mouse-face highlight)))
+ ;; Insert D-Bus message.
+ (goto-char (point-max))
+ (insert
+ (format
+ (concat
+ "%s time=%s sender=%s -> destination=%s serial=%s "
+ "path=%s interface=%s member=%s\n")
+ (cond
+ ((= type dbus-message-type-method-call) dbus-monitor-method-call)
+ ((= type dbus-message-type-method-return) dbus-monitor-method-return)
+ ((= type dbus-message-type-error) dbus-monitor-error)
+ ((= type dbus-message-type-signal) dbus-monitor-signal))
+ time sender destination serial path interface member))
+ (dolist (arg arguments)
+ (pp (dbus-flatten-types arg) (current-buffer)))
+ (insert "\n")
+ ;; Show byte arrays as string.
+ (goto-char point)
+ (while (re-search-forward
+ "(:array\\( :byte [[:digit:]]+\\)+)" nil 'noerror)
+ (put-text-property
+ (match-beginning 0) (match-end 0)
+ 'help-echo (dbus-byte-array-to-string (read (match-string 0)))))
+ ;; Show fixed numbers.
+ (goto-char point)
+ (while (re-search-forward
+ (concat
+ (regexp-opt
+ '(":int16" ":uint16" ":int32" ":uint32" ":int64" ":uint64"))
+ " \\([-+[:digit:]]+\\)")
+ nil 'noerror)
+ (put-text-property
+ (match-beginning 1) (match-end 1)
+ 'help-echo
+ (format
+ "#o%o, #x%X" (read (match-string 1)) (read (match-string 1)))))
+ ;; Show floating numbers.
+ (goto-char point)
+ (while (re-search-forward ":double \\([-+.[:digit:]]+\\)" nil 'noerror)
+ (put-text-property
+ (match-beginning 1) (match-end 1)
+ 'help-echo (format "%e" (read (match-string 1))))))
+ (when eobp
+ (goto-char (point-max))))))
+
(defun dbus-handle-bus-disconnect ()
"React to a bus disconnection.
BUS is the bus that disconnected. This routine unregisters all
handlers on the given bus and causes all synchronous calls
pending at the time of disconnect to fail."
(let ((bus (dbus-event-bus-name last-input-event))
- (keys-to-remove))
+ keys-to-remove)
(maphash
(lambda (key value)
(when (and (eq (nth 0 key) :serial)
@@ -1788,13 +2186,14 @@ pending at the time of disconnect to fail."
(list 'dbus-event
bus
dbus-message-type-error
- (nth 2 key)
- nil
- nil
- nil
- nil
- value)
- (list 'dbus-error "Bus disconnected" bus))
+ (nth 2 key) ; serial
+ nil ; service
+ nil ; destination
+ nil ; path
+ nil ; interface
+ nil ; member
+ value) ; handler
+ (list 'dbus-error dbus-error-disconnected "Bus disconnected" bus))
(push key keys-to-remove)))
dbus-registered-objects-table)
(dolist (key keys-to-remove)
@@ -1803,10 +2202,11 @@ pending at the time of disconnect to fail."
(defun dbus-init-bus (bus &optional private)
"Establish the connection to D-Bus BUS.
-BUS can be either the symbol `:system' or the symbol `:session', or it
-can be a string denoting the address of the corresponding bus. For
-the system and session buses, this function is called when loading
-`dbus.el', there is no need to call it again.
+BUS can be either the keyword `:system' or the keyword
+`:session', or it can be a string denoting the address of the
+corresponding bus. For the system and session buses, this
+function is called when loading `dbus.el', there is no need to
+call it again.
The function returns the number of connections this Emacs session
has established to the BUS under the same unique name (see
@@ -1816,13 +2216,13 @@ example, if Emacs is linked with the GTK+ toolkit, and it runs in
a GTK+-aware environment like GNOME, another connection might
already be established.
-When PRIVATE is non-nil, a new connection is established instead of
-reusing an existing one. It results in a new unique name at the bus.
-This can be used, if it is necessary to distinguish from another
-connection used in the same Emacs process, like the one established by
-GTK+. It should be used with care for at least the `:system' and
-`:session' buses, because other Emacs Lisp packages might already use
-this connection to those buses."
+When PRIVATE is non-nil, a new connection is established instead
+of reusing an existing one. It results in a new unique name at
+the bus. This can be used, if it is necessary to distinguish
+from another connection used in the same Emacs process, like the
+one established by GTK+. If BUS is the keyword `:system' or the
+keyword `:session', the new connection is identified by the
+keywords `:system-private' or `:session-private', respectively."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
(prog1
@@ -1847,5 +2247,9 @@ this connection to those buses."
;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
+;;
+;; * Cache introspection data.
+;;
+;; * Run handlers in own threads.
;;; dbus.el ends here
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index 852d8ae0491..f36999119f2 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -1,4 +1,4 @@
-;;; dig.el --- Domain Name System dig interface
+;;; dig.el --- Domain Name System dig interface -*- lexical-binding:t -*-
;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
@@ -42,15 +42,13 @@
(defcustom dig-program "dig"
"Name of dig (domain information groper) binary."
- :type 'file
- :group 'dig)
+ :type 'file)
(defcustom dig-dns-server nil
"DNS server to query.
If nil, use system defaults."
:type '(choice (const :tag "System defaults")
- string)
- :group 'dig)
+ string))
(defcustom dig-font-lock-keywords
'(("^;; [A-Z]+ SECTION:" 0 font-lock-keyword-face)
@@ -58,8 +56,7 @@ If nil, use system defaults."
("^; <<>>.*" 0 font-lock-type-face)
("^;.*" 0 font-lock-function-name-face))
"Default expressions to highlight in dig mode."
- :type 'sexp
- :group 'dig)
+ :type 'sexp)
(defun dig-invoke (domain &optional
query-type query-class query-option
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index cefe0851f03..c368cd773c2 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -1,4 +1,4 @@
-;;; dns.el --- Domain Name Service lookups
+;;; dns.el --- Domain Name Service lookups -*- lexical-binding:t -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@@ -24,6 +24,8 @@
;;; Code:
+(require 'cl-lib)
+
(defvar dns-timeout 5
"How many seconds to wait when doing DNS queries.")
@@ -73,7 +75,7 @@ updated. Set this variable to t to disable the check.")
(defun dns-write-bytes (value &optional length)
(let (bytes)
- (dotimes (i (or length 1))
+ (dotimes (_ (or length 1))
(push (% value 256) bytes)
(setq value (/ value 256)))
(dolist (byte bytes)
@@ -81,7 +83,7 @@ updated. Set this variable to t to disable the check.")
(defun dns-read-bytes (length)
(let ((value 0))
- (dotimes (i length)
+ (dotimes (_ length)
(setq value (logior (* value 256) (following-char)))
(forward-char 1))
value))
@@ -138,7 +140,7 @@ updated. Set this variable to t to disable the check.")
(defun dns-write (spec &optional tcp-p)
"Write a DNS packet according to SPEC.
-If TCP-P, the first two bytes of the package with be the length field."
+If TCP-P, the first two bytes of the packet will be the length field."
(with-temp-buffer
(set-buffer-multibyte nil)
(dns-write-bytes (dns-get 'id spec) 2)
@@ -189,13 +191,15 @@ If TCP-P, the first two bytes of the package with be the length field."
(dns-write-bytes (buffer-size) 2))
(buffer-string)))
-(defun dns-read (packet)
+(defun dns-read (packet &optional tcp-p)
(with-temp-buffer
(set-buffer-multibyte nil)
(let ((spec nil)
queries answers authorities additionals)
(insert packet)
- (goto-char (point-min))
+ ;; When using TCP we have a 2 byte length field to ignore.
+ (goto-char (+ (point-min)
+ (if tcp-p 2 0)))
(push (list 'id (dns-read-bytes 2)) spec)
(let ((byte (dns-read-bytes 1)))
(push (list 'response-p (if (zerop (logand byte (ash 1 7))) nil t))
@@ -227,7 +231,7 @@ If TCP-P, the first two bytes of the package with be the length field."
(setq authorities (dns-read-bytes 2))
(setq additionals (dns-read-bytes 2))
(let ((qs nil))
- (dotimes (i queries)
+ (dotimes (_ queries)
(push (list (dns-read-name)
(list 'type (dns-inverse-get (dns-read-bytes 2)
dns-query-types))
@@ -235,33 +239,36 @@ If TCP-P, the first two bytes of the package with be the length field."
dns-classes)))
qs))
(push (list 'queries qs) spec))
- (dolist (slot '(answers authorities additionals))
- (let ((qs nil)
- type)
- (dotimes (i (symbol-value slot))
- (push (list (dns-read-name)
- (list 'type
- (setq type (dns-inverse-get (dns-read-bytes 2)
- dns-query-types)))
- (list 'class (dns-inverse-get (dns-read-bytes 2)
- dns-classes))
- (list 'ttl (dns-read-bytes 4))
- (let ((length (dns-read-bytes 2)))
- (list 'data
- (dns-read-type
- (buffer-substring
- (point)
- (progn (forward-char length) (point)))
- type))))
- qs))
- (push (list slot qs) spec)))
+ (cl-loop for (slot length) in `((answers ,answers)
+ (authorities ,authorities)
+ (additionals ,additionals))
+ do (let ((qs nil)
+ type)
+ (dotimes (_ length)
+ (push (list (dns-read-name)
+ (list 'type
+ (setq type (dns-inverse-get
+ (dns-read-bytes 2)
+ dns-query-types)))
+ (list 'class (dns-inverse-get
+ (dns-read-bytes 2)
+ dns-classes))
+ (list 'ttl (dns-read-bytes 4))
+ (let ((length (dns-read-bytes 2)))
+ (list 'data
+ (dns-read-type
+ (buffer-substring
+ (point)
+ (progn (forward-char length)
+ (point)))
+ type))))
+ qs))
+ (push (list slot qs) spec)))
(nreverse spec))))
(defun dns-read-int32 ()
- ;; Full 32 bit Integers can't be handled by 32-bit Emacsen. If we
- ;; use floats, it works.
- (format "%.0f" (+ (* (dns-read-bytes 1) 16777216.0)
- (dns-read-bytes 3))))
+ (declare (obsolete nil "28.1"))
+ (number-to-string (dns-read-bytes 4)))
(defun dns-read-type (string type)
(let ((buffer (current-buffer))
@@ -274,23 +281,23 @@ If TCP-P, the first two bytes of the package with be the length field."
(cond
((eq type 'A)
(let ((bytes nil))
- (dotimes (i 4)
+ (dotimes (_ 4)
(push (dns-read-bytes 1) bytes))
(mapconcat 'number-to-string (nreverse bytes) ".")))
((eq type 'AAAA)
(let (hextets)
- (dotimes (i 8)
+ (dotimes (_ 8)
(push (dns-read-bytes 2) hextets))
(mapconcat (lambda (n) (format "%x" n))
(nreverse hextets) ":")))
((eq type 'SOA)
(list (list 'mname (dns-read-name buffer))
(list 'rname (dns-read-name buffer))
- (list 'serial (dns-read-int32))
- (list 'refresh (dns-read-int32))
- (list 'retry (dns-read-int32))
- (list 'expire (dns-read-int32))
- (list 'minimum (dns-read-int32))))
+ (list 'serial (dns-read-bytes 4))
+ (list 'refresh (dns-read-bytes 4))
+ (list 'retry (dns-read-bytes 4))
+ (list 'expire (dns-read-bytes 4))
+ (list 'minimum (dns-read-bytes 4))))
((eq type 'SRV)
(list (list 'priority (dns-read-bytes 2))
(list 'weight (dns-read-bytes 2))
@@ -309,16 +316,14 @@ If TCP-P, the first two bytes of the package with be the length field."
"Return false if we need to recheck the list of DNS servers."
(and dns-servers
(or (eq dns-servers-valid-for-interfaces t)
- ;; `network-interface-list' was introduced in Emacs 22.1.
- (not (fboundp 'network-interface-list))
(equal dns-servers-valid-for-interfaces
(network-interface-list)))))
(defun dns-set-servers ()
"Set `dns-servers' to a list of DNS servers or nil if none are found.
Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
+ (setq dns-servers nil)
(or (when (file-exists-p "/etc/resolv.conf")
- (setq dns-servers nil)
(with-temp-buffer
(insert-file-contents "/etc/resolv.conf")
(goto-char (point-min))
@@ -329,11 +334,10 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
(with-temp-buffer
(call-process "nslookup" nil t nil "localhost")
(goto-char (point-min))
- (re-search-forward
- "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
- (setq dns-servers (list (match-string 1))))))
- (when (fboundp 'network-interface-list)
- (setq dns-servers-valid-for-interfaces (network-interface-list))))
+ (when (re-search-forward
+ "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\|[[:xdigit:]:]*\\)" nil t)
+ (setq dns-servers (list (match-string 1)))))))
+ (setq dns-servers-valid-for-interfaces (network-interface-list)))
(defun dns-read-txt (string)
(if (> (length string) 1)
@@ -355,23 +359,6 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
result))
;;; Interface functions.
-(defmacro dns-make-network-process (server)
- `(let ((server ,server)
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary))
- (if (fboundp 'make-network-process)
- (make-network-process
- :name "dns"
- :coding 'binary
- :buffer (current-buffer)
- :host server
- :service "domain"
- :type 'datagram)
- ;; Older versions of Emacs doesn't have
- ;; `make-network-process', so we fall back on opening a TCP
- ;; connection to the DNS server.
- (open-network-stream "dns" (current-buffer) server "domain"))))
-
(defvar dns-cache (make-vector 4096 0))
(defun dns-query-cached (name &optional type fullp reversep)
@@ -384,64 +371,141 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
(set (intern key dns-cache) result)
result))))
-;; The old names `query-dns' and `query-dns-cached' weren't used in Emacs 23
-;; yet, so no alias are provided. --rsteib
-
-(defun dns-query (name &optional type fullp reversep)
+(defun dns-query-asynchronous (name callback &optional type full reverse)
"Query a DNS server for NAME of TYPE.
-If FULLP, return the entire record returned.
-If REVERSEP, look up an IP address."
+CALLBACK will be called with a single parameter: The result.
+
+If there's no result, or `dns-timeout' has passed, CALLBACK will
+be called with nil as the parameter.
+
+If FULL, return the entire record.
+If REVERSE, look up an IP address."
(setq type (or type 'A))
(unless (dns-servers-up-to-date-p)
(dns-set-servers))
- (when reversep
+ (when reverse
(setq name (concat
(mapconcat 'identity (nreverse (split-string name "\\.")) ".")
".in-addr.arpa")
type 'PTR))
(if (not dns-servers)
- (message "No DNS server configuration found")
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (let ((process (condition-case ()
- (dns-make-network-process (car dns-servers))
- (error
- (message
- "dns: Got an error while trying to talk to %s"
- (car dns-servers))
- nil)))
- (step 100)
- (times (* dns-timeout 1000))
- (id (random 65000)))
- (when process
- (process-send-string
- process
- (dns-write `((id ,id)
- (opcode query)
- (queries ((,name (type ,type))))
- (recursion-desired-p t))))
- (while (and (zerop (buffer-size))
- (> times 0))
- (let ((step-sec (/ step 1000.0)))
- (sit-for step-sec)
- (accept-process-output process step-sec))
- (setq times (- times step)))
- (condition-case nil
- (delete-process process)
- (error nil))
- (when (and (>= (buffer-size) 2)
- ;; We had a time-out.
- (> times 0))
- (let ((result (dns-read (buffer-string))))
- (if fullp
- result
- (let ((answer (car (dns-get 'answers result))))
- (when (eq type (dns-get 'type answer))
- (if (eq type 'TXT)
- (dns-get-txt-answer (dns-get 'answers result))
- (dns-get 'data answer))))))))))))
+ (progn
+ (message "No DNS server configuration found")
+ nil)
+ (dns--lookup name callback type full)))
+
+(defun dns--lookup (name callback type full)
+ (with-current-buffer (generate-new-buffer " *dns*")
+ (set-buffer-multibyte nil)
+ (let* ((tcp nil)
+ (process
+ (condition-case ()
+ (let ((server (car dns-servers))
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (if (featurep 'make-network-process '(:type datagram))
+ (make-network-process
+ :name "dns"
+ :coding 'binary
+ :buffer (current-buffer)
+ :host server
+ :service "domain"
+ :type 'datagram)
+ ;; On MS-Windows datagram sockets are not
+ ;; supported, so we fall back on opening a TCP
+ ;; connection to the DNS server.
+ (progn
+ (setq tcp t)
+ (open-network-stream "dns" (current-buffer)
+ server "domain"))))
+ (error
+ (message
+ "dns: Got an error while trying to talk to %s"
+ (car dns-servers))
+ nil)))
+ (triggered nil)
+ (buffer (current-buffer))
+ timer)
+ (if (not process)
+ (progn
+ (kill-buffer buffer)
+ (funcall callback nil))
+ ;; Call the callback if we don't get any response at all.
+ (setq timer (run-at-time dns-timeout nil
+ (lambda ()
+ (unless triggered
+ (setq triggered t)
+ (delete-process process)
+ (kill-buffer buffer)
+ (funcall callback nil)))))
+ (process-send-string
+ process
+ (dns-write `((id ,(random 65000))
+ (opcode query)
+ (queries ((,name (type ,type))))
+ (recursion-desired-p t))
+ tcp))
+ (set-process-filter
+ process
+ (lambda (process string)
+ (with-current-buffer (process-buffer process)
+ (goto-char (point-max))
+ (insert string)
+ (goto-char (point-min))
+ ;; If this is DNS, then we always get the full data in
+ ;; one packet. If it's TCP, we may only get part of the
+ ;; data, but the first two bytes says how long the data
+ ;; is supposed to be.
+ (when (or (not tcp)
+ (>= (buffer-size) (dns-read-bytes 2)))
+ (setq triggered t)
+ (cancel-timer timer)
+ (dns--filter process callback type full tcp)))))
+ ;; In case we the process is deleted for some reason, then do
+ ;; a failure callback.
+ (set-process-sentinel
+ process
+ (lambda (_ state)
+ (when (and (eq state 'deleted)
+ ;; Ensure we don't trigger this callback twice.
+ (not triggered))
+ (setq triggered t)
+ (cancel-timer timer)
+ (kill-buffer buffer)
+ (funcall callback nil))))))))
+
+(defun dns--filter (process callback type full tcp)
+ (let ((message (buffer-string)))
+ (when (process-live-p process)
+ (delete-process process))
+ (kill-buffer (current-buffer))
+ (when (>= (length message) 2)
+ (let ((result (dns-read message tcp)))
+ (funcall callback
+ (if full
+ result
+ (let ((answer (car (dns-get 'answers result))))
+ (when (eq type (dns-get 'type answer))
+ (if (eq type 'TXT)
+ (dns-get-txt-answer (dns-get 'answers result))
+ (dns-get 'data answer))))))))))
+
+(defun dns-query (name &optional type full reverse)
+ "Query a DNS server for NAME of TYPE.
+If FULL, return the entire record returned.
+If REVERSE, look up an IP address."
+ (let ((result nil))
+ (dns-query-asynchronous
+ name
+ (lambda (response)
+ (setq result (list response)))
+ type full reverse)
+ ;; Loop until we get the callback.
+ (while (not result)
+ (sleep-for 0.01))
+ (car result)))
(provide 'dns)
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 20a5c5f6075..bb6682520ae 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -1,4 +1,4 @@
-;;; eudc-bob.el --- Binary Objects Support for EUDC
+;;; eudc-bob.el --- Binary Objects Support for EUDC -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -39,19 +39,41 @@
(require 'eudc)
-(defvar eudc-bob-generic-keymap nil
+(defvar eudc-bob-generic-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "s" 'eudc-bob-save-object)
+ (define-key map "!" 'eudc-bob-pipe-object-to-external-program)
+ (define-key map [down-mouse-3] 'eudc-bob-popup-menu)
+ map)
"Keymap for multimedia objects.")
-(defvar eudc-bob-image-keymap nil
+(defvar eudc-bob-image-keymap
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map eudc-bob-generic-keymap)
+ (define-key map "t" 'eudc-bob-toggle-inline-display)
+ map)
"Keymap for inline images.")
-(defvar eudc-bob-sound-keymap nil
+(defvar eudc-bob-sound-keymap
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map eudc-bob-generic-keymap)
+ (define-key map (kbd "RET") 'eudc-bob-play-sound-at-point)
+ (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
+ map)
"Keymap for inline sounds.")
-(defvar eudc-bob-url-keymap nil
+(defvar eudc-bob-url-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") 'browse-url-at-point)
+ (define-key map [down-mouse-2] 'browse-url-at-mouse)
+ map)
"Keymap for inline urls.")
-(defvar eudc-bob-mail-keymap nil
+(defvar eudc-bob-mail-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") 'goto-address-at-point)
+ (define-key map [down-mouse-2] 'goto-address-at-point)
+ map)
"Keymap for inline e-mail addresses.")
(defvar eudc-bob-generic-menu
@@ -71,16 +93,9 @@
`("EUDC Sound Menu"
["---" nil nil]
["Play sound" eudc-bob-play-sound-at-point
- (fboundp 'play-sound)]
+ (fboundp 'play-sound-internal)]
,@(cdr (cdr eudc-bob-generic-menu))))
-(defun eudc-jump-to-event (event)
- "Jump to the window and point where EVENT occurred."
- (if (fboundp 'event-closest-point)
- (goto-char (event-closest-point event))
- (set-buffer (window-buffer (posn-window (event-start event))))
- (goto-char (posn-point (event-start event)))))
-
(defun eudc-bob-get-overlay-prop (prop)
"Get property PROP from one of the overlays around."
(let ((overlays (append (overlays-at (1- (point)))
@@ -197,7 +212,7 @@ display a button."
(let (sound)
(if (null (setq sound (eudc-bob-get-overlay-prop 'object-data)))
(error "No sound data available here")
- (unless (fboundp 'play-sound)
+ (unless (fboundp 'play-sound-internal)
(error "Playing sounds not supported on this system"))
(play-sound (list 'sound :data sound)))))
@@ -205,44 +220,30 @@ display a button."
"Play the sound data contained in the button where EVENT occurred."
(interactive "e")
(save-excursion
- (eudc-jump-to-event event)
+ (mouse-set-point event)
(eudc-bob-play-sound-at-point)))
-(defun eudc-bob-save-object ()
+(defun eudc-bob-save-object (filename)
"Save the object data of the button at point."
- (interactive)
+ (interactive "fWrite file: ")
(let ((data (eudc-bob-get-overlay-prop 'object-data))
- (buffer (generate-new-buffer "*eudc-tmp*")))
- (save-excursion
- (if (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system 'binary))
- (set-buffer buffer)
- (set-buffer-multibyte nil)
- (insert data)
- (save-buffer))
- (kill-buffer buffer)))
+ (coding-system-for-write 'binary)) ;Inhibit EOL conversion.
+ (write-region data nil filename)))
-(defun eudc-bob-pipe-object-to-external-program ()
+(defun eudc-bob-pipe-object-to-external-program (program)
"Pipe the object data of the button at point to an external program."
- (interactive)
+ (interactive (list (completing-read "Viewer: " eudc-external-viewers)))
(let ((data (eudc-bob-get-overlay-prop 'object-data))
- (buffer (generate-new-buffer "*eudc-tmp*"))
- program
- viewer)
- (condition-case nil
- (save-excursion
- (if (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system 'binary))
- (set-buffer buffer)
- (insert data)
- (setq program (completing-read "Viewer: " eudc-external-viewers))
- (if (setq viewer (assoc program eudc-external-viewers))
- (call-process-region (point-min) (point-max)
- (car (cdr viewer))
- (cdr (cdr viewer)))
- (call-process-region (point-min) (point-max) program)))
- (error
- (kill-buffer buffer)))))
+ (viewer (assoc program eudc-external-viewers)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert data)
+ (let ((coding-system-for-write 'binary)) ;Inhibit EOL conversion
+ (if viewer
+ (call-process-region (point-min) (point-max)
+ (car (cdr viewer))
+ (cdr (cdr viewer)))
+ (call-process-region (point-min) (point-max) program))))))
(defun eudc-bob-menu ()
"Retrieve the menu attached to a binary object."
@@ -252,47 +253,8 @@ display a button."
"Pop-up a menu of EUDC multimedia commands."
(interactive "@e")
(run-hooks 'activate-menubar-hook)
- (eudc-jump-to-event event)
- (let ((result (x-popup-menu t (eudc-bob-menu)))
- command)
- (if result
- (progn
- (setq command (lookup-key (eudc-bob-menu)
- (apply 'vector result)))
- (command-execute command)))))
-
-(setq eudc-bob-generic-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map "s" 'eudc-bob-save-object)
- (define-key map "!" 'eudc-bob-pipe-object-to-external-program)
- (define-key map [down-mouse-3] 'eudc-bob-popup-menu)
- map))
-
-(setq eudc-bob-image-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map "t" 'eudc-bob-toggle-inline-display)
- map))
-
-(setq eudc-bob-sound-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'eudc-bob-play-sound-at-point)
- (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
- map))
-
-(setq eudc-bob-url-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'browse-url-at-point)
- (define-key map [down-mouse-2] 'browse-url-at-mouse)
- map))
-
-(setq eudc-bob-mail-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'goto-address-at-point)
- (define-key map [down-mouse-2] 'goto-address-at-point)
- map))
-
-(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap)
-(set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap)
+ (mouse-set-point event)
+ (popup-menu (eudc-bob-menu) event))
;; If the first arguments can be nil here, then these 3 can be
;; defconsts once more.
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index bc939e0d396..bb1474b8b5b 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -1,4 +1,4 @@
-;;; eudc-vars.el --- Emacs Unified Directory Client
+;;; eudc-vars.el --- Emacs Unified Directory Client -*- lexical-binding: t -*-
;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 88c58f5729a..14cc7db2fa8 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -76,12 +76,11 @@
"Do some cleanup in a RECORD to make it suitable for EUDC."
(declare (obsolete eudc-ldap-cleanup-record-filtering-addresses "25.1"))
(mapcar
- (function
- (lambda (field)
- (cons (intern (downcase (car field)))
- (if (cdr (cdr field))
- (cdr field)
- (car (cdr field))))))
+ (lambda (field)
+ (cons (intern (downcase (car field)))
+ (if (cdr (cdr field))
+ (cdr field)
+ (car (cdr field)))))
record))
(defun eudc-filter-$ (string)
@@ -138,10 +137,10 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
;; Apply eudc-duplicate-attribute-handling-method
(if (not (eq 'list eudc-duplicate-attribute-handling-method))
(mapc
- (function (lambda (record)
- (setq final-result
- (append (eudc-filter-duplicate-attributes record)
- final-result))))
+ (lambda (record)
+ (setq final-result
+ (append (eudc-filter-duplicate-attributes record)
+ final-result)))
result))
final-result))
diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el
new file mode 100644
index 00000000000..3c0d88fc23f
--- /dev/null
+++ b/lisp/net/eudcb-macos-contacts.el
@@ -0,0 +1,123 @@
+;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Alexander Adolf
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This library provides an interface to the macOS Contacts app as
+;; an EUDC data source. It uses AppleScript to interface with the
+;; Contacts app on localhost, so no 3rd party tools are needed.
+
+;;; Usage:
+;; (require 'eudcb-macos-contacts)
+;; (eudc-macos-contacts-set-server "localhost")
+
+;;; Code:
+
+(require 'eudc)
+(require 'executable)
+
+;;{{{ Internal cooking
+
+(defvar eudc-macos-contacts-conversion-alist nil)
+
+;; hook ourselves into the EUDC framework
+(eudc-protocol-set 'eudc-query-function
+ 'eudc-macos-contacts-query-internal
+ 'macos-contacts)
+(eudc-protocol-set 'eudc-list-attributes-function
+ nil
+ 'macos-contacts)
+(eudc-protocol-set 'eudc-macos-contacts-conversion-alist
+ nil
+ 'macos-contacts)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes
+ nil
+ 'macos-contacts)
+
+(defun eudc-macos-contacts-search-helper (str)
+ "Helper function to query the Contacts app via AppleScript.
+Searches for all persons with a case-insensitive substring match
+of STR in any of their name fields (first, middle, or last)."
+ (if (executable-find "osascript")
+ (call-process "osascript" nil t nil
+ "-e"
+ (format "
+set results to {}
+tell application \"Address Book\"
+ set pList to every person whose (name contains \"%s\")
+ repeat with pers in pList
+ repeat with emailAddr in emails of pers
+ set results to results & {name of pers & \":\" & value ¬
+ of emailAddr & \"\n\"}
+ end repeat
+ end repeat
+ get results as text
+end tell" str))
+ (message (concat "[eudc] Error in macOS Contacts backend: "
+ "`osascript' executable not found. "
+ "Is this is a macOS 10.0 or later system?"))))
+
+(defun eudc-macos-contacts-query-internal (query &optional return-attrs)
+ "Query macOS Contacts with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
+macOS Contacts attribute names.
+RETURN-ATTRS is a list of attributes to return, defaulting to
+`eudc-default-return-attributes'."
+ (let ((macos-contacts-buffer (get-buffer-create " *macOS Contacts*"))
+ result)
+ (with-current-buffer macos-contacts-buffer
+ (erase-buffer)
+ (dolist (term query)
+ (eudc-macos-contacts-search-helper (cdr term)))
+ (delete-duplicate-lines (point-min) (point-max))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (not (equal (line-beginning-position) (line-end-position)))
+ (let* ((args (split-string (buffer-substring
+ (point) (line-end-position))
+ ":"))
+ (name (nth 0 args))
+ (email (nth 1 args)))
+ (setq result (cons `((name . ,name)
+ (email . ,email))
+ result))))
+ (forward-line))
+ result)))
+
+;;}}}
+
+;;{{{ High-level interfaces (interactive functions)
+
+(defun eudc-macos-contacts-set-server (dummy)
+ "Set the EUDC server to macOS Contacts app.
+The server in DUMMY is not actually used, since this backend
+always and implicitly connetcs to an instance of the Contacts app
+running on the local host."
+ (interactive)
+ (eudc-set-server dummy 'macos-contacts)
+ (message "[eudc] macOS Contacts app server selected"))
+
+;;}}}
+
+(eudc-register-protocol 'macos-contacts)
+
+(provide 'eudcb-macos-contacts)
+
+;;; eudcb-macos-contacts.el ends here
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index d6f850ca3ba..9ed01ecc473 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -25,14 +25,15 @@
;;; Code:
(require 'cl-lib)
-(require 'format-spec)
+(require 'mm-url)
+(require 'puny)
(require 'shr)
+(require 'text-property-search)
+(require 'thingatpt)
(require 'url)
(require 'url-queue)
-(require 'thingatpt)
-(require 'mm-url)
-(require 'puny)
-(eval-when-compile (require 'subr-x)) ;; for string-trim
+(require 'xdg)
+(eval-when-compile (require 'subr-x))
(defgroup eww nil
"Emacs Web Wowser"
@@ -55,11 +56,24 @@
:group 'eww
:type 'string)
-(defcustom eww-download-directory "~/Downloads/"
- "Directory where files will downloaded."
- :version "24.4"
+(defun erc--download-directory ()
+ "Return the name of the download directory.
+If ~/Downloads/ exists, that will be used, and if not, the
+DOWNLOAD XDG user directory will be returned. If that's
+undefined, ~/Downloads/ is returned anyway."
+ (or (and (file-exists-p "~/Downloads/")
+ "~/Downloads/")
+ (when-let ((dir (xdg-user-dir "DOWNLOAD")))
+ (file-name-as-directory dir))
+ "~/Downloads/"))
+
+(defcustom eww-download-directory 'erc--download-directory
+ "Directory where files will downloaded.
+This should either be a directory name or a function (called with
+no parameters) that returns a directory name."
+ :version "28.1"
:group 'eww
- :type 'directory)
+ :type '(choice directory function))
;;;###autoload
(defcustom eww-suggest-uris
@@ -120,6 +134,15 @@ The string will be passed through `substitute-command-keys'."
:type '(choice (const :tag "Unlimited" nil)
integer))
+(defcustom eww-retrieve-command nil
+ "Command to retrieve an URL via an external program.
+If nil, `url-retrieve' is used to download the data. If non-nil,
+this should be a list where the first item is the program, and
+the rest are the arguments."
+ :version "28.1"
+ :type '(choice (const :tag "Use `url-retrieve'" nil)
+ (repeat string)))
+
(defcustom eww-use-external-browser-for-content-type
"\\`\\(video/\\|audio/\\|application/ogg\\)"
"Always use external browser for specified content-type."
@@ -263,19 +286,40 @@ This list can be customized via `eww-suggest-uris'."
(nreverse uris)))
;;;###autoload
-(defun eww (url &optional arg)
+(defun eww-browse ()
+ "Function to be run to parse command line URLs.
+This is meant to be used for MIME handlers or command line use.
+
+Setting the handler for \"text/x-uri;\" to
+\"emacs -f eww-browse %u\" will then start up Emacs and call eww
+to browse the url.
+
+This can also be used on the command line directly:
+
+ emacs -f eww-browse https://gnu.org
+
+will start Emacs and browse the GNU web site."
+ (interactive)
+ (eww (pop command-line-args-left)))
+
+
+;;;###autoload
+(defun eww (url &optional arg buffer)
"Fetch URL and render the page.
If the input doesn't look like an URL or a domain name, the
word(s) will be searched for via `eww-search-prefix'.
If called with a prefix ARG, use a new buffer instead of reusing
-the default EWW buffer."
+the default EWW buffer.
+
+If BUFFER, the data to be rendered is in that buffer. In that
+case, this function doesn't actually fetch URL. BUFFER will be
+killed after rendering."
(interactive
- (let* ((uris (eww-suggested-uris))
- (prompt (concat "Enter URL or keywords"
- (if uris (format " (default %s)" (car uris)) "")
- ": ")))
- (list (read-string prompt nil 'eww-prompt-history uris)
+ (let ((uris (eww-suggested-uris)))
+ (list (read-string (format-prompt "Enter URL or keywords"
+ (and uris (car uris)))
+ nil 'eww-prompt-history uris)
(prefix-numeric-value current-prefix-arg))))
(setq url (eww--dwim-expand-url url))
(pop-to-buffer-same-window
@@ -307,8 +351,39 @@ the default EWW buffer."
(insert (format "Loading %s..." url))
(goto-char (point-min)))
(let ((url-mime-accept-string eww-accept-content-types))
- (url-retrieve url 'eww-render
- (list url nil (current-buffer)))))
+ (if buffer
+ (let ((eww-buffer (current-buffer)))
+ (with-current-buffer buffer
+ (eww-render nil url nil eww-buffer)))
+ (eww-retrieve url #'eww-render
+ (list url nil (current-buffer))))))
+
+(defun eww-retrieve (url callback cbargs)
+ (if (null eww-retrieve-command)
+ (url-retrieve url #'eww-render
+ (list url nil (current-buffer)))
+ (let ((buffer (generate-new-buffer " *eww retrieve*"))
+ (error-buffer (generate-new-buffer " *eww error*")))
+ (with-current-buffer buffer
+ (set-buffer-multibyte nil)
+ (make-process
+ :name "*eww fetch*"
+ :buffer (current-buffer)
+ :stderr error-buffer
+ :command (append eww-retrieve-command (list url))
+ :sentinel (lambda (process _)
+ (unless (process-live-p process)
+ (when (buffer-live-p error-buffer)
+ (when (get-buffer-process error-buffer)
+ (delete-process (get-buffer-process error-buffer) ))
+ (kill-buffer error-buffer))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (insert "Content-type: text/html; charset=utf-8\n\n")
+ (apply #'funcall callback nil cbargs))))))))))
+
+(function-put 'eww 'browse-url-browser-kind 'internal)
(defun eww--dwim-expand-url (url)
(setq url (string-trim url))
@@ -359,7 +434,19 @@ the default EWW buffer."
(eww (concat "file://"
(and (memq system-type '(windows-nt ms-dos))
"/")
- (expand-file-name file))))
+ (expand-file-name file))
+ nil
+ ;; The file name may be a non-local Tramp file. The URL
+ ;; library doesn't understand these file names, so use the
+ ;; normal Emacs machinery to load the file.
+ (with-current-buffer (generate-new-buffer " *eww file*")
+ (set-buffer-multibyte nil)
+ (insert "Content-type: " (or (mailcap-extension-to-mime
+ (url-file-extension file))
+ "application/octet-stream")
+ "\n\n")
+ (insert-file-contents file)
+ (current-buffer))))
;;;###autoload
(defun eww-search-words ()
@@ -373,8 +460,8 @@ for the search engine used."
(let ((region-string (buffer-substring (region-beginning) (region-end))))
(if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string))
(eww region-string)
- (call-interactively 'eww)))
- (call-interactively 'eww)))
+ (call-interactively #'eww)))
+ (call-interactively #'eww)))
(defun eww-open-in-new-buffer ()
"Fetch link at point in a new EWW buffer."
@@ -541,10 +628,10 @@ Currently this means either text/html or application/xhtml+xml."
(goto-char point))
(shr-target-id
(goto-char (point-min))
- (let ((point (next-single-property-change
- (point-min) 'shr-target-id)))
- (when point
- (goto-char point))))
+ (let ((match (text-property-search-forward
+ 'shr-target-id shr-target-id t)))
+ (when match
+ (goto-char (prop-match-beginning match)))))
(t
(goto-char (point-min))
;; Don't leave point inside forms, because the normal eww
@@ -608,31 +695,88 @@ Currently this means either text/html or application/xhtml+xml."
(eww-handle-link dom)
(let ((start (point)))
(shr-tag-a dom)
- (put-text-property start (point)
- 'keymap
- (if (mm-images-in-region-p start (point))
- eww-image-link-keymap
- eww-link-keymap))))
+ (if (dom-attr dom 'href)
+ (put-text-property start (point)
+ 'keymap
+ (if (mm-images-in-region-p start (point))
+ eww-image-link-keymap
+ eww-link-keymap)))))
+
+(defun eww--limit-string-pixelwise (string pixels)
+ (if (not pixels)
+ string
+ (with-temp-buffer
+ (insert string)
+ (if (< (eww--pixel-column) pixels)
+ string
+ ;; Iterate to find appropriate length.
+ (while (and (> (eww--pixel-column) pixels)
+ (not (bobp)))
+ (forward-char -1))
+ ;; Return at least one character.
+ (buffer-substring (point-min) (max (point)
+ (1+ (point-min))))))))
+
+(defun eww--pixel-column ()
+ (if (not (get-buffer-window (current-buffer)))
+ (save-window-excursion
+ ;; Avoid errors if the selected window is a dedicated one,
+ ;; and they just want to insert a document into it.
+ (set-window-dedicated-p nil nil)
+ (set-window-buffer nil (current-buffer))
+ (car (window-text-pixel-size nil (line-beginning-position) (point))))
+ (car (window-text-pixel-size nil (line-beginning-position) (point)))))
(defun eww-update-header-line-format ()
(setq header-line-format
(and eww-header-line-format
- (let ((title (plist-get eww-data :title))
- (peer (plist-get eww-data :peer)))
- (when (zerop (length title))
- (setq title "[untitled]"))
- ;; This connection has is https.
+ (let ((peer (plist-get eww-data :peer))
+ (url (plist-get eww-data :url))
+ (title (propertize
+ (if (zerop (length (plist-get eww-data :title)))
+ "[untitled]"
+ (plist-get eww-data :title))
+ 'face 'variable-pitch)))
+ ;; This connection is https.
(when peer
- (setq title
- (propertize title 'face
- (if (plist-get peer :warnings)
- 'eww-invalid-certificate
- 'eww-valid-certificate))))
+ (add-face-text-property 0 (length title)
+ (if (plist-get peer :warnings)
+ 'eww-invalid-certificate
+ 'eww-valid-certificate)
+ t title))
+ ;; Limit the length of the title so that the host name
+ ;; of the URL is always visible.
+ (when url
+ (setq url (propertize url 'face 'variable-pitch))
+ (let* ((parsed (url-generic-parse-url url))
+ (host-length (shr-string-pixel-width
+ (propertize
+ (format "%s://%s" (url-type parsed)
+ (url-host parsed))
+ 'face 'variable-pitch)))
+ (width (window-width nil t)))
+ (cond
+ ;; The host bit is wider than the window, so nix
+ ;; the title.
+ ((> (+ host-length (shr-string-pixel-width "xxxxx")) width)
+ (setq title ""))
+ ;; Trim the title.
+ ((> (+ (shr-string-pixel-width (concat title "xx"))
+ host-length)
+ width)
+ (setq title
+ (concat
+ (eww--limit-string-pixelwise
+ title (- width host-length
+ (shr-string-pixel-width
+ (propertize "...: " 'face
+ 'variable-pitch))))
+ (propertize "..." 'face 'variable-pitch)))))))
(replace-regexp-in-string
"%" "%%"
(format-spec
eww-header-line-format
- `((?u . ,(or (plist-get eww-data :url) ""))
+ `((?u . ,(or url ""))
(?t . ,title))))))))
(defun eww-tag-title (dom)
@@ -667,14 +811,19 @@ Currently this means either text/html or application/xhtml+xml."
(declare-function mailcap-view-mime "mailcap" (type))
(defun eww-display-pdf ()
- (let ((data (buffer-substring (point) (point-max))))
- (pop-to-buffer-same-window (get-buffer-create "*eww pdf*"))
- (let ((coding-system-for-write 'raw-text)
- (inhibit-read-only t))
- (erase-buffer)
- (insert data)
- (mailcap-view-mime "application/pdf")))
- (goto-char (point-min)))
+ (let ((buf (current-buffer))
+ (pos (point)))
+ (with-current-buffer (get-buffer-create "*eww pdf*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (set-buffer-multibyte nil)
+ (insert-buffer-substring buf pos)
+ (mailcap-view-mime "application/pdf"))
+ (if (zerop (buffer-size))
+ ;; Buffer contents passed to shell command via temporary file.
+ (kill-buffer)
+ (goto-char (point-min))
+ (pop-to-buffer-same-window (current-buffer))))))
(defun eww-setup-buffer ()
(when (or (plist-get eww-data :url)
@@ -1011,7 +1160,7 @@ just re-display the HTML already fetched."
(eww-display-html 'utf-8 url (plist-get eww-data :dom)
(point) (current-buffer)))
(let ((url-mime-accept-string eww-accept-content-types))
- (url-retrieve url 'eww-render
+ (eww-retrieve url #'eww-render
(list url (point) (current-buffer) encode))))))
;; Form support.
@@ -1046,6 +1195,7 @@ just re-display the HTML already fetched."
(define-key map [(control e)] 'eww-end-of-text)
(define-key map [?\t] 'shr-next-link)
(define-key map [?\M-\t] 'shr-previous-link)
+ (define-key map [backtab] 'shr-previous-link)
map))
(defvar eww-textarea-map
@@ -1055,11 +1205,14 @@ just re-display the HTML already fetched."
(define-key map [(control c) (control c)] 'eww-submit)
(define-key map [?\t] 'shr-next-link)
(define-key map [?\M-\t] 'shr-previous-link)
+ (define-key map [backtab] 'shr-previous-link)
map))
(defvar eww-select-map
(let ((map (make-sparse-keymap)))
(define-key map "\r" 'eww-change-select)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [mouse-2] 'eww-change-select)
(define-key map [(control c) (control c)] 'eww-submit)
map))
@@ -1111,11 +1264,13 @@ just re-display the HTML already fetched."
(defun eww-form-submit (dom)
(let ((start (point))
(value (dom-attr dom 'value)))
- (setq value
- (if (zerop (length value))
- "Submit"
- value))
- (insert value)
+ (if (null value)
+ (shr-generic dom)
+ (insert value))
+ ;; If the contents of the <button>...</button> turns out to be
+ ;; empty, or the value was blank, default to this:
+ (when (= (point) start)
+ (insert "Submit"))
(add-face-text-property start (point) 'eww-form-submit)
(put-text-property start (point) 'eww-form
(list :eww-form eww-form
@@ -1256,7 +1411,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-tag-textarea (dom)
(let ((start (point))
- (value (or (dom-attr dom 'value) ""))
+ (value (or (dom-text dom) ""))
(lines (string-to-number (or (dom-attr dom 'rows) "10")))
(width (string-to-number (or (dom-attr dom 'cols) "10")))
end)
@@ -1325,16 +1480,15 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(options nil)
(start (point))
(max 0))
- (dolist (elem (dom-non-text-children dom))
- (when (eq (dom-tag elem) 'option)
- (when (dom-attr elem 'selected)
- (nconc menu (list :value (dom-attr elem 'value))))
- (let ((display (dom-text elem)))
- (setq max (max max (length display)))
- (push (list 'item
- :value (dom-attr elem 'value)
- :display display)
- options))))
+ (dolist (elem (dom-by-tag dom 'option))
+ (when (dom-attr elem 'selected)
+ (nconc menu (list :value (dom-attr elem 'value))))
+ (let ((display (dom-text elem)))
+ (setq max (max max (length display)))
+ (push (list 'item
+ :value (dom-attr elem 'value)
+ :display display)
+ options)))
(when options
(setq options (nreverse options))
;; If we have no selected values, default to the first value.
@@ -1361,25 +1515,30 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(setq display (plist-get (cdr elem) :display))))
display))
-(defun eww-change-select ()
+(defun eww--form-items (form)
+ (cl-loop for elem in form
+ when (and (consp elem)
+ (eq (car elem) 'item))
+ collect (cdr elem)))
+
+(defun eww-change-select (event)
"Change the value of the select drop-down menu under point."
- (interactive)
- (let* ((input (get-text-property (point) 'eww-form))
- (completion-ignore-case t)
- (options
- (delq nil
- (mapcar (lambda (elem)
- (and (consp elem)
- (eq (car elem) 'item)
- (cons (plist-get (cdr elem) :display)
- (plist-get (cdr elem) :value))))
- input)))
- (display
- (completing-read "Change value: " options nil 'require-match))
- (inhibit-read-only t))
- (plist-put input :value (cdr (assoc-string display options t)))
- (goto-char
- (eww-update-field display))))
+ (interactive (list last-nonmenu-event))
+ (mouse-set-point event)
+ (let ((input (get-text-property (point) 'eww-form)))
+ (popup-menu
+ (cons
+ "Change Value"
+ (mapcar
+ (lambda (elem)
+ (vector (plist-get elem :display)
+ (lambda ()
+ (interactive)
+ (plist-put input :value (plist-get elem :value))
+ (goto-char (eww-update-field (plist-get elem :display))))
+ t))
+ (eww--form-items input)))
+ event)))
(defun eww-update-field (string &optional offset)
(unless offset
@@ -1483,7 +1642,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(cond
((member (plist-get input :type) '("checkbox" "radio"))
(when (plist-get input :checked)
- (push (cons name (plist-get input :value))
+ (push (cons name (or (plist-get input :value) "on"))
values)))
((equal (plist-get input :type) "file")
(when-let ((file (plist-get input :filename)))
@@ -1572,8 +1731,10 @@ If EXTERNAL is double prefix, browse in new buffer."
(cond
((not url)
(message "No link under point"))
- ((string-match "^mailto:" url)
- (browse-url-mail url))
+ ((string-match-p "\\`mailto:" url)
+ ;; This respects the user options `browse-url-handlers'
+ ;; and `browse-url-mailto-function'.
+ (browse-url url))
((and (consp external) (<= (car external) 4))
(funcall browse-url-secondary-browser-function url)
(shr--blink-link))
@@ -1606,20 +1767,23 @@ Differences in #targets are ignored."
"Download URL to `eww-download-directory'.
Use link at point if there is one, else the current page's URL."
(interactive)
- (access-file eww-download-directory "Download failed")
- (let ((url (or (get-text-property (point) 'shr-url)
- (eww-current-url))))
- (if (not url)
- (message "No URL under point")
- (url-retrieve url 'eww-download-callback (list url)))))
-
-(defun eww-download-callback (status url)
+ (let ((dir (if (stringp eww-download-directory)
+ eww-download-directory
+ (funcall eww-download-directory))))
+ (access-file dir "Download failed")
+ (let ((url (or (get-text-property (point) 'shr-url)
+ (eww-current-url))))
+ (if (not url)
+ (message "No URL under point")
+ (url-retrieve url #'eww-download-callback (list url dir))))))
+
+(defun eww-download-callback (status url dir)
(unless (plist-get status :error)
(let* ((obj (url-generic-parse-url url))
(path (directory-file-name (car (url-path-and-query obj))))
(file (eww-make-unique-file-name
(eww-decode-url-file-name (file-name-nondirectory path))
- eww-download-directory)))
+ dir)))
(goto-char (point-min))
(re-search-forward "\r?\n\r?\n")
(let ((coding-system-for-write 'no-conversion))
@@ -1735,28 +1899,30 @@ If CHARSET is nil then use UTF-8."
(defun eww-write-bookmarks ()
(with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
- (insert ";; Auto-generated file; don't edit\n")
+ (insert ";; Auto-generated file; don't edit -*- mode: lisp-data -*-\n")
(pp eww-bookmarks (current-buffer))))
-(defun eww-read-bookmarks ()
+(defun eww-read-bookmarks (&optional error-out)
+ "Read bookmarks from `eww-bookmarks'.
+If ERROR-OUT, signal user-error if there are no bookmarks."
(let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)))
(setq eww-bookmarks
(unless (zerop (or (file-attribute-size (file-attributes file)) 0))
(with-temp-buffer
(insert-file-contents file)
- (read (current-buffer)))))))
+ (read (current-buffer)))))
+ (when (and error-out (not eww-bookmarks))
+ (user-error "No bookmarks are defined"))))
;;;###autoload
(defun eww-list-bookmarks ()
"Display the bookmarks."
(interactive)
+ (eww-read-bookmarks t)
(pop-to-buffer "*eww bookmarks*")
(eww-bookmark-prepare))
(defun eww-bookmark-prepare ()
- (eww-read-bookmarks)
- (unless eww-bookmarks
- (user-error "No bookmarks are defined"))
(set-buffer (get-buffer-create "*eww bookmarks*"))
(eww-bookmark-mode)
(let* ((width (/ (window-width) 2))
@@ -1824,6 +1990,7 @@ If CHARSET is nil then use UTF-8."
bookmark)
(unless (get-buffer "*eww bookmarks*")
(setq first t)
+ (eww-read-bookmarks t)
(eww-bookmark-prepare))
(with-current-buffer (get-buffer "*eww bookmarks*")
(when (and (not first)
@@ -1842,6 +2009,7 @@ If CHARSET is nil then use UTF-8."
bookmark)
(unless (get-buffer "*eww bookmarks*")
(setq first t)
+ (eww-read-bookmarks t)
(eww-bookmark-prepare))
(with-current-buffer (get-buffer "*eww bookmarks*")
(if first
@@ -2124,12 +2292,12 @@ entries (if any) will be removed from the list.
Only the properties listed in `eww-desktop-data-save' are included.
Generally, the list should not include the (usually overly large)
:dom, :source and :text properties."
- (let ((history (mapcar 'eww-desktop-data-1
- (cons eww-data eww-history))))
- (list :history (if eww-desktop-remove-duplicates
- (cl-remove-duplicates
- history :test 'eww-desktop-history-duplicate)
- history))))
+ (let ((history (mapcar #'eww-desktop-data-1
+ (cons eww-data eww-history))))
+ (list :history (if eww-desktop-remove-duplicates
+ (cl-remove-duplicates
+ history :test #'eww-desktop-history-duplicate)
+ history))))
(defun eww-restore-desktop (file-name buffer-name misc-data)
"Restore an eww buffer from its desktop file record.
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 5212bf6a3f6..8ad721964dd 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -170,8 +170,9 @@ Third arg HOST is the name of the host to connect to, or its IP address.
Fourth arg SERVICE is the name of the service desired, or an integer
specifying a port number to connect to.
Fifth arg PARAMETERS is an optional list of keyword/value pairs.
-Only :client-certificate and :nowait keywords are recognized, and
-have the same meaning as for `open-network-stream'.
+Only :client-certificate, :nowait, and :coding keywords are
+recognized, and have the same meaning as for
+`open-network-stream'.
For historical reasons PARAMETERS can also be a symbol, which is
interpreted the same as passing a list containing :nowait and the
value of that symbol.
@@ -209,7 +210,8 @@ trust and key files, and priority string."
(gnutls-boot-parameters
:type 'gnutls-x509pki
:keylist keylist
- :hostname (puny-encode-domain host)))))))
+ :hostname (puny-encode-domain host))))
+ :coding (plist-get parameters :coding))))
(if nowait
process
(gnutls-negotiate :process process
@@ -346,8 +348,11 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(t nil))))
(min-prime-bits (or min-prime-bits gnutls-min-prime-bits)))
- (when verify-hostname-error
- (push :hostname verify-error))
+ ;; Only add :hostname if `verify-error' is not t, since t
+ ;; means "include :hostname" Bug#38602.
+ (and verify-hostname-error
+ (not (eq verify-error t))
+ (push :hostname verify-error))
`(:priority ,priority-string
:hostname ,hostname
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 9436f45aa32..43bea76a6bc 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -280,6 +280,16 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
(widen)
(goto-address-unfontify (point-min) (point-max)))))
+(defun goto-addr-mode--turn-on ()
+ (when (not goto-address-mode)
+ (goto-address-mode 1)))
+
+;;;###autoload
+(define-globalized-minor-mode global-goto-address-mode
+ goto-address-mode goto-addr-mode--turn-on
+ :group 'goto-address
+ :version "28.1")
+
;;;###autoload
(define-minor-mode goto-address-prog-mode
"Like `goto-address-mode', but only for comments and strings."
diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el
index bfacc73a2a4..944cc6cef6c 100644
--- a/lisp/net/hmac-def.el
+++ b/lisp/net/hmac-def.el
@@ -1,4 +1,4 @@
-;;; hmac-def.el --- A macro for defining HMAC functions.
+;;; hmac-def.el --- A macro for defining HMAC functions. -*- lexical-binding: t -*-
;; Copyright (C) 1999, 2001, 2007-2020 Free Software Foundation, Inc.
diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el
index 92efb6ba275..974ee0d3691 100644
--- a/lisp/net/hmac-md5.el
+++ b/lisp/net/hmac-md5.el
@@ -1,4 +1,4 @@
-;;; hmac-md5.el --- Compute HMAC-MD5.
+;;; hmac-md5.el --- Compute HMAC-MD5. -*- lexical-binding:t -*-
;; Copyright (C) 1999, 2001, 2007-2020 Free Software Foundation, Inc.
@@ -22,42 +22,8 @@
;;; Commentary:
-;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1".
-;;
-;; (encode-hex-string (hmac-md5 "Hi There" (make-string 16 ?\x0b)))
-;; => "9294727a3638bb1c13f48ef8158bfc9d"
-;;
-;; (encode-hex-string (hmac-md5 "what do ya want for nothing?" "Jefe"))
-;; => "750c783e6ab0b503eaa86e310a5db738"
-;;
-;; (encode-hex-string (hmac-md5 (make-string 50 ?\xdd) (make-string 16 ?\xaa)))
-;; => "56be34521d144c88dbb8c733f0e8b3f6"
-;;
-;; (encode-hex-string
-;; (hmac-md5
-;; (make-string 50 ?\xcd)
-;; (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819")))
-;; => "697eaf0aca3a3aea3a75164746ffaa79"
-;;
-;; (encode-hex-string
-;; (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c)))
-;; => "56461ef2342edc00f9bab995690efd4c"
-;;
-;; (encode-hex-string
-;; (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c)))
-;; => "56461ef2342edc00f9bab995"
-;;
-;; (encode-hex-string
-;; (hmac-md5
-;; "Test Using Larger Than Block-Size Key - Hash Key First"
-;; (make-string 80 ?\xaa)))
-;; => "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"
-;;
-;; (encode-hex-string
-;; (hmac-md5
-;; "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
-;; (make-string 80 ?\xaa)))
-;; => "6f630fad67cda0ee1fb1f562db3aa53e"
+;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1",
+;; moved to lisp/test/net/hmac-md5-tests.el
;;; Code:
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index aa10f0291fd..22b59084004 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -134,9 +134,9 @@
;;
;;; Code:
+;;; Dependencies
(eval-when-compile (require 'cl-lib))
-(require 'format-spec)
(require 'utf7)
(require 'rfc2104)
;; Hmm... digest-md5 is not part of Emacs.
@@ -146,7 +146,7 @@
(declare-function digest-md5-digest-uri "ext:digest-md5")
(declare-function digest-md5-challenge "ext:digest-md5")
-;; User variables.
+;;; User variables
(defgroup imap nil
"Low-level IMAP issues."
@@ -258,7 +258,7 @@ Shorter values mean quicker response, but is more CPU intensive."
:group 'imap
:type 'boolean)
-;; Various variables.
+;;; Various variables
(defvar imap-fetch-data-hook nil
"Hooks called after receiving each FETCH response.")
@@ -317,7 +317,9 @@ the value of this variable will be bound to a certain value to which
an application program that uses this module specifies on a per-server
basis.")
-;; Internal constants. Change these and die.
+;;; Internal constants
+
+;; Change these and die.
(defconst imap-default-port 143)
(defconst imap-default-ssl-port 993)
@@ -349,7 +351,7 @@ basis.")
(defconst imap-log-buffer "*imap-log*")
(defconst imap-debug-buffer "*imap-debug*")
-;; Internal variables.
+;;; Internal variables
(defvar imap-stream nil)
(defvar imap-auth nil)
@@ -438,7 +440,7 @@ This variable is set to t automatically per server if the
canonical form fails.")
-;; Utility functions:
+;;; Utility functions
(defun imap-remassoc (key alist)
"Delete by side effect any elements of ALIST whose car is `equal' to KEY.
@@ -490,7 +492,8 @@ sure of changing the value of `foo'."
(nth 3 (car imap-failed-tags))))
-;; Server functions; stream stuff:
+;;; Server functions
+;;;; Stream functions
(defun imap-log (string-or-buffer)
(when imap-log
@@ -517,12 +520,9 @@ sure of changing the value of `foo'."
(process-connection-type imap-process-connection-type)
(process (start-process
name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?p (number-to-string port)
- ?l imap-default-user))))
+ (format-spec cmd `((?s . ,server)
+ (?p . ,(number-to-string port))
+ (?l . ,imap-default-user)))))
response)
(when process
(with-current-buffer buffer
@@ -583,12 +583,9 @@ sure of changing the value of `foo'."
(process-connection-type imap-process-connection-type)
(process (start-process
name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?p (number-to-string port)
- ?l imap-default-user))))
+ (format-spec cmd `((?s . ,server)
+ (?p . ,(number-to-string port))
+ (?l . ,imap-default-user)))))
response)
(when process
(with-current-buffer buffer
@@ -701,13 +698,10 @@ sure of changing the value of `foo'."
(process-connection-type imap-process-connection-type)
(process (start-process
name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?g imap-shell-host
- ?p (number-to-string port)
- ?l imap-default-user)))))
+ (format-spec cmd `((?s . ,server)
+ (?g . ,imap-shell-host)
+ (?p . ,(number-to-string port))
+ (?l . ,imap-default-user))))))
(when process
(while (and (memq (process-status process) '(open run))
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
@@ -757,7 +751,7 @@ sure of changing the value of `foo'."
(message "imap: Connecting with STARTTLS...%s" (if done "done" "failed"))
done))
-;; Server functions; authenticator stuff:
+;;;; Authenticator functions
(defun imap-interactive-login (buffer loginfunc)
"Login to server in BUFFER.
@@ -881,7 +875,7 @@ t if it successfully authenticates, nil otherwise."
(concat "LOGIN anonymous \"" (concat (user-login-name) "@"
(system-name)) "\"")))))
-;;; Compiler directives.
+;;; Compiler directives
(defvar imap-sasl-client)
(defvar imap-sasl-step)
@@ -979,7 +973,7 @@ t if it successfully authenticates, nil otherwise."
(imap-send-command-1 "")
(imap-ok-p (imap-wait-for-tag tag)))))))
-;; Server functions:
+;;; Server functions
(defun imap-open-1 (buffer)
(with-current-buffer buffer
@@ -1238,7 +1232,7 @@ If BUFFER is nil, the current buffer is assumed."
(imap-send-command-wait "LOGOUT" buffer)))
-;; Mailbox functions:
+;;; Mailbox functions
(defun imap-mailbox-put (propname value &optional mailbox buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -1530,7 +1524,7 @@ or `unseen'. The IMAP command tag is returned."
identifier))))))
-;; Message functions:
+;;; Message functions
(defun imap-current-message (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -1842,7 +1836,7 @@ on failure."
(if (aref from 0) ">"))))
-;; Internal functions.
+;;; Internal functions
(defun imap-add-callback (tag func)
(setq imap-callbacks (append (list (cons tag func)) imap-callbacks)))
@@ -1979,7 +1973,7 @@ Return nil if no complete line has arrived."
(delete-region (point-min) (point-max)))))))))
-;; Imap parser.
+;;; Imap parser
(defsubst imap-forward ()
(or (eobp) (forward-char)))
@@ -2860,6 +2854,8 @@ Return nil if no complete line has arrived."
(imap-forward)
(nreverse body)))))
+;;; Debug
+
(when imap-debug ; (untrace-all)
(require 'trace)
(buffer-disable-undo (get-buffer-create imap-debug-buffer))
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index e42a7655ef3..5639d52f815 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -29,7 +29,7 @@
;; `ldapsearch' to actually perform the searches. That program can be
;; found in all LDAP developer kits such as:
;; - UM-LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/)
-;; - OpenLDAP (http://www.openldap.org/)
+;; - OpenLDAP (https://www.openldap.org/)
;;; Code:
@@ -727,7 +727,7 @@ an alist of attribute/value pairs."
(setq record nil)
(skip-chars-forward " \t\n")
(message "Parsing results... %d" numres)
- (1+ numres))
+ (setq numres (1+ numres)))
(message "Parsing results... done")
(nreverse result)))))
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 5fe5b4d3a54..d0f8c1272d7 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -29,6 +29,7 @@
;;; Code:
+(require 'cl-lib)
(autoload 'mail-header-parse-content-type "mail-parse")
(defgroup mailcap nil
@@ -174,11 +175,11 @@ is consulted."
(type . "application/zip")
("copiousoutput"))
("pdf"
- (viewer . pdf-view-mode)
+ (viewer . doc-view-mode)
(type . "application/pdf")
(test . window-system))
("pdf"
- (viewer . doc-view-mode)
+ (viewer . pdf-view-mode)
(type . "application/pdf")
(test . window-system))
("pdf"
@@ -268,11 +269,6 @@ is consulted."
(viewer . "display %s")
(type . "image/*")
(test . (eq window-system 'x))
- ("needsx11"))
- (".*"
- (viewer . "ee %s")
- (type . "image/*")
- (test . (eq window-system 'x))
("needsx11")))
("text"
("plain"
@@ -334,9 +330,16 @@ Content-Type header as argument to return a boolean value for the
validity. Otherwise, if it is a non-function Lisp symbol or list
whose car is a symbol, it is `eval'uated to yield the validity. If it
is a string or list of strings, it represents a shell command to run
-to return a true or false shell value for the validity.")
+to return a true or false shell value for the validity.
+
+The last matching entry in this structure takes presedence over
+preceding entries.")
(put 'mailcap-mime-data 'risky-local-variable t)
+(defvar mailcap--computed-mime-data nil
+ "Computed version of the mailcap data incorporating all sources.
+Same format as `mailcap-mime-data'.")
+
(defcustom mailcap-download-directory nil
"Directory to which `mailcap-save-binary-file' downloads files by default.
nil means your home directory."
@@ -422,7 +425,13 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
(when (or (not mailcap-parsed-p)
force)
;; Clear out all old data.
- (setq mailcap-mime-data nil)
+ (setq mailcap--computed-mime-data nil)
+ ;; Add the Emacs-distributed defaults (which will be used as
+ ;; fallbacks). Do it this way instead of just copying the list,
+ ;; since entries are destructively modified.
+ (cl-loop for (major . minors) in mailcap-mime-data
+ do (cl-loop for (minor . entry) in minors
+ do (mailcap-add-mailcap-entry major minor entry)))
(cond
(path nil)
((getenv "MAILCAPS")
@@ -709,10 +718,13 @@ to supply to the test."
(push (list otest result) mailcap-viewer-test-cache)
result))))
-(defun mailcap-add-mailcap-entry (major minor info)
- (let ((old-major (assoc major mailcap-mime-data)))
+(defun mailcap-add-mailcap-entry (major minor info &optional storage)
+ (let* ((storage (or storage 'mailcap--computed-mime-data))
+ (old-major (assoc major (symbol-value storage))))
(if (null old-major) ; New major area
- (push (cons major (list (cons minor info))) mailcap-mime-data)
+ (set storage
+ (cons (cons major (list (cons minor info)))
+ (symbol-value storage)))
(let ((cur-minor (assoc minor old-major)))
(cond
((or (null cur-minor) ; New minor area, or
@@ -736,11 +748,15 @@ If TEST is not given, it defaults to t."
(when (or (not (car tl))
(not (cadr tl)))
(error "%s is not a valid MIME type" type))
- (mailcap-add-mailcap-entry
- (car tl) (cadr tl)
- `((viewer . ,viewer)
- (test . ,(if test test t))
- (type . ,type)))))
+ (let ((entry
+ `((viewer . ,viewer)
+ (test . ,(if test test t))
+ (type . ,type))))
+ ;; Store it.
+ (mailcap-add-mailcap-entry (car tl) (cadr tl) entry
+ 'mailcap-user-mime-data)
+ ;; Make it available for usage.
+ (mailcap-add-mailcap-entry (car tl) (cadr tl) entry))))
;;;
;;; The main whabbo
@@ -791,13 +807,13 @@ If NO-DECODE is non-nil, don't decode STRING."
;; NO-DECODE avoids calling `mail-header-parse-content-type' from
;; `mail-parse.el'
(let (
- major ; Major encoding (text, etc)
- minor ; Minor encoding (html, etc)
- info ; Other info
- major-info ; (assoc major mailcap-mime-data)
- viewers ; Possible viewers
- passed ; Viewers that passed the test
- viewer ; The one and only viewer
+ major ; Major encoding (text, etc)
+ minor ; Minor encoding (html, etc)
+ info ; Other info
+ major-info ; (assoc major mailcap--computed-mime-data)
+ viewers ; Possible viewers
+ passed ; Viewers that passed the test
+ viewer ; The one and only viewer
ctl)
(save-excursion
(setq ctl
@@ -809,12 +825,12 @@ If NO-DECODE is non-nil, don't decode STRING."
(if viewer
(setq passed (list viewer))
;; None found, so heuristically select some applicable viewer
- ;; from `mailcap-mime-data'.
+ ;; from `mailcap--computed-mime-data'.
(mailcap-parse-mailcaps nil t)
(setq major (split-string (car ctl) "/"))
(setq minor (cadr major)
major (car major))
- (when (setq major-info (cdr (assoc major mailcap-mime-data)))
+ (when (setq major-info (cdr (assoc major mailcap--computed-mime-data)))
(when (setq viewers (mailcap-possible-viewers major-info minor))
(setq info (mapcar (lambda (a)
(cons (symbol-name (car a)) (cdr a)))
@@ -847,7 +863,7 @@ If NO-DECODE is non-nil, don't decode STRING."
((eq request 'all)
passed)
(t
- ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
+ ;; MUST make a copy *sigh*, else we modify mailcap--computed-mime-data
(setq viewer (copy-sequence viewer))
(let ((view (assq 'viewer viewer))
(test (assq 'test viewer)))
@@ -1057,7 +1073,7 @@ For instance, \"foo.png\" will result in \"image/png\"."
(nconc
(mapcar 'cdr mailcap-mime-extensions)
(let (res type)
- (dolist (data mailcap-mime-data)
+ (dolist (data mailcap--computed-mime-data)
(dolist (info (cdr data))
(setq type (cdr (assq 'type (cdr info))))
(unless (string-match-p "\\*" type)
@@ -1115,16 +1131,30 @@ For instance, \"foo.png\" will result in \"image/png\"."
res)))
(nreverse res)))))
+(defun mailcap--async-shell (command file)
+ "Asynchronously call MIME viewer shell COMMAND.
+Replace %s in COMMAND with FILE, as per `mailcap-mime-data'.
+Delete FILE once COMMAND exits."
+ (let ((buf (get-buffer-create " *mailcap shell*")))
+ (async-shell-command (format command file) buf)
+ (add-function :after (process-sentinel (get-buffer-process buf))
+ (lambda (proc _msg)
+ (when (memq (process-status proc) '(exit signal))
+ (delete-file file))))))
+
(defun mailcap-view-mime (type)
"View the data in the current buffer that has MIME type TYPE.
-`mailcap-mime-data' determines the method to use."
+The variable `mailcap--computed-mime-data' determines the method
+to use. If the method is a shell command string, erase the
+current buffer after passing its contents to the shell command."
(let ((method (mailcap-mime-info type)))
(if (stringp method)
- (shell-command-on-region (point-min) (point-max)
- ;; Use stdin as the "%s".
- (format method "-")
- (current-buffer)
- t)
+ (let* ((ext (concat "." (cadr (split-string type "/"))))
+ (file (make-temp-file "emacs-mailcap" nil ext))
+ (coding-system-for-write 'binary))
+ (write-region nil nil file nil 'silent)
+ (delete-region (point-min) (point-max))
+ (mailcap--async-shell method file))
(funcall method))))
(provide 'mailcap)
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index ef3651b0335..8777fe4bf46 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -771,7 +771,7 @@ This command uses `smbclient-program' to connect to HOST."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Full list is available at:
-;; http://www.iana.org/assignments/port-numbers
+;; https://www.iana.org/assignments/port-numbers
(defvar network-connection-service-alist
(list
(cons 'echo 7)
@@ -985,9 +985,8 @@ This command uses `network-connection-service-alist', which see."
(read-from-minibuffer "Host: " (net-utils-machine-at-point))
(completing-read "Service: "
(mapcar
- (function
- (lambda (elt)
- (list (symbol-name (car elt)))))
+ (lambda (elt)
+ (list (symbol-name (car elt))))
network-connection-service-alist))))
(network-connection
host
diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el
index 3c7f243e801..01db97c29d4 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -1,4 +1,5 @@
-;;; netrc.el --- .netrc parsing functionality
+;;; netrc.el --- .netrc parsing functionality -*- lexical-binding: t -*-
+
;; Copyright (C) 1996-2020 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -40,8 +41,7 @@
(defcustom netrc-file "~/.authinfo"
"File where user credentials are stored."
:version "24.1"
- :type 'file
- :group 'netrc)
+ :type 'file)
(defvar netrc-services-file "/etc/services"
"The name of the services file.")
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index e99d7a372c0..e86426d4664 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -113,6 +113,10 @@ values:
`ssl' -- Equivalent to `tls'.
`shell' -- A shell connection.
+:coding is a symbol or a cons used to specify the coding systems
+used to decode and encode the data which the process reads and
+writes. See `make-network-process' for details.
+
:return-list specifies this function's return value.
If omitted or nil, return a process object. A non-nil means to
return (PROC . PROPS), where PROC is a process object and PROPS
@@ -135,7 +139,10 @@ values:
:capability-command specifies a command used to query the HOST
for its capabilities. For instance, for IMAP this should be
- \"1 CAPABILITY\\r\\n\".
+ \"1 CAPABILITY\\r\\n\". This can either be a string (which will
+ then be sent verbatim to the server), or a function (called with
+ a single parameter; the \"greeting\" from the server when connecting),
+ and should return a string to send to the server.
:starttls-function specifies a function for handling STARTTLS.
This function should take one parameter, the response to the
@@ -166,8 +173,8 @@ a greeting from the server.
:nowait, if non-nil, says the connection should be made
asynchronously, if possible.
-:shell-command is a format-spec string that can be used if :type
-is `shell'. It has two specs, %s for host and %p for port
+:shell-command is a `format-spec' string that can be used if
+:type is `shell'. It has two specs, %s for host and %p for port
number. Example: \"ssh gateway nc %s %p\".
:tls-parameters is a list that should be supplied if you're
@@ -189,7 +196,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
:host (puny-encode-domain host) :service service
:nowait (plist-get parameters :nowait)
:tls-parameters
- (plist-get parameters :tls-parameters))
+ (plist-get parameters :tls-parameters)
+ :coding (plist-get parameters :coding))
(let ((work-buffer (or buffer
(generate-new-buffer " *stream buffer*")))
(fun (cond ((and (eq type 'plain)
@@ -249,7 +257,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(stream (make-network-process :name name :buffer buffer
:host (puny-encode-domain host)
:service service
- :nowait (plist-get parameters :nowait))))
+ :nowait (plist-get parameters :nowait)
+ :coding (plist-get parameters :coding))))
(when (plist-get parameters :warn-unless-encrypted)
(setq stream (nsm-verify-connection stream host service nil t)))
(list stream
@@ -270,11 +279,15 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE)
(stream (make-network-process :name name :buffer buffer
:host (puny-encode-domain host)
- :service service))
+ :service service
+ :coding (plist-get parameters :coding)))
(greeting (and (not (plist-get parameters :nogreeting))
(network-stream-get-response stream start eoc)))
- (capabilities (network-stream-command stream capability-command
- eo-capa))
+ (capabilities
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ eo-capa))
(resulting-type 'plain)
starttls-available starttls-command error)
@@ -322,7 +335,10 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
;; Requery capabilities for protocols that require it; i.e.,
;; EHLO for SMTP.
(when (plist-get parameters :always-query-capabilities)
- (network-stream-command stream capability-command eo-capa)))
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ eo-capa)))
(when (let ((response
(network-stream-command stream starttls-command eoc)))
(and response (string-match success-string response)))
@@ -350,14 +366,18 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(setq stream
(make-network-process :name name :buffer buffer
:host (puny-encode-domain host)
- :service service))
+ :service service
+ :coding (plist-get parameters :coding)))
(network-stream-get-response stream start eoc)))
(unless (process-live-p stream)
(error "Unable to negotiate a TLS connection with %s/%s"
host service))
;; Re-get the capabilities, which may have now changed.
(setq capabilities
- (network-stream-command stream capability-command eo-capa))))
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ eo-capa))))
;; If TLS is mandatory, close the connection if it's unencrypted.
(when (and require-tls
@@ -420,7 +440,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
parameters)
(require 'tls)
(open-tls-stream name buffer host service)))
- (eoc (plist-get parameters :end-of-command)))
+ (eoc (plist-get parameters :end-of-command))
+ greeting)
(if (plist-get parameters :nowait)
(list stream nil nil 'tls)
;; Check certificate validity etc.
@@ -432,42 +453,58 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
;; openssl/gnutls-cli.
(when (and (not (gnutls-available-p))
eoc)
- (network-stream-get-response stream start eoc)
+ (setq greeting (network-stream-get-response stream start eoc))
(goto-char (point-min))
(when (re-search-forward eoc nil t)
(goto-char (match-beginning 0))
(delete-region (point-min) (line-beginning-position))))
- (let ((capability-command (plist-get parameters :capability-command))
+ (let ((capability-command
+ (plist-get parameters :capability-command))
(eo-capa (or (plist-get parameters :end-of-capability)
eoc)))
(list stream
(network-stream-get-response stream start eoc)
- (network-stream-command stream capability-command eo-capa)
+ (network-stream-command
+ stream
+ (network-stream--capability-command
+ capability-command greeting)
+ eo-capa)
'tls)))))))
-(declare-function format-spec "format-spec" (format spec))
-(declare-function format-spec-make "format-spec" (&rest pairs))
-
(defun network-stream-open-shell (name buffer host service parameters)
- (require 'format-spec)
(let* ((capability-command (plist-get parameters :capability-command))
(eoc (plist-get parameters :end-of-command))
(start (with-current-buffer buffer (point)))
+ (coding (plist-get parameters :coding))
(stream (let ((process-connection-type nil))
(start-process name buffer shell-file-name
shell-command-switch
(format-spec
(plist-get parameters :shell-command)
- (format-spec-make
- ?s host
- ?p service))))))
+ `((?s . ,host)
+ (?p . ,service))))))
+ greeting)
+ (when coding (if (consp coding)
+ (set-process-coding-system stream
+ (car coding)
+ (cdr coding))
+ (set-process-coding-system stream
+ coding
+ coding)))
(list stream
- (network-stream-get-response stream start eoc)
- (network-stream-command stream capability-command
- (or (plist-get parameters :end-of-capability)
- eoc))
+ (setq greeting (network-stream-get-response stream start eoc))
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ (or (plist-get parameters :end-of-capability)
+ eoc))
'plain)))
+(defun network-stream--capability-command (command greeting)
+ (if (functionp command)
+ (funcall command greeting)
+ command))
+
(provide 'network-stream)
;;; network-stream.el ends here
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index eb61d7a6796..f45abf780f7 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -68,9 +68,6 @@ considered to be running if the newsticker timer list is not empty."
;; Hard-coding URLs like this is a recipe for propagating obsolete info.
(defconst newsticker--raw-url-list-defaults
'(
- ;; 2017/12: no response.
-;;; ("CNET News.com"
-;;; "http://export.cnet.com/export/feeds/news/rss/1,11176,,00.xml")
("Debian Security Advisories"
"http://www.debian.org/security/dsa.en.rdf")
("Debian Security Advisories - Long format"
@@ -81,11 +78,6 @@ considered to be running if the newsticker timer list is not empty."
3600)
("LWN (Linux Weekly News)"
"https://lwn.net/headlines/rss")
- ;; Not updated since 2010.
-;;; ("NY Times: Technology"
-;;; "http://www.nytimes.com/services/xml/rss/userland/Technology.xml")
-;;; ("NY Times"
-;;; "http://www.nytimes.com/services/xml/rss/userland/HomePage.xml")
("Quote of the day"
"http://feeds.feedburner.com/quotationspage/qotd"
"07:00"
@@ -363,7 +355,7 @@ description are marked as immortal."
(const :tag "Title" title)
(const :tag "Description" description)
(const :tag "All" all))
- (string :tag "Regexp")))))
+ (regexp :tag "Regexp")))))
:group 'newsticker-headline-processing)
;; ======================================================================
@@ -898,7 +890,7 @@ Argument BUFFER is the buffer of the retrieval process."
;; Atom 1.0 feed.
;; (and (eq 'feed (xml-node-name topnode))
- ;; (string= "http://www.w3.org/2005/Atom"
+ ;; (string= "https://www.w3.org/2005/Atom"
;; (xml-get-attribute topnode 'xmlns)))
(setq image-url (newsticker--get-logo-url-atom-1.0 topnode))
(setq icon-url (newsticker--get-icon-url-atom-1.0 topnode))
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index 1bed61f3e7d..ff8a447c7c1 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -131,14 +131,6 @@ groupcontent := feedname | groupdefinition)
Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
\"feed3\")")
-(defcustom newsticker-groups-filename
- nil
- "Name of the newsticker groups settings file."
- :version "25.1" ; changed default value to nil
- :type '(choice (const nil) string)
- :group 'newsticker-treeview)
-(make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
-
;; ======================================================================
;;; internal variables
;; ======================================================================
@@ -1265,29 +1257,9 @@ Note: does not update the layout."
(defun newsticker--treeview-load ()
"Load treeview settings."
(let* ((coding-system-for-read 'utf-8)
- (filename
- (or (and newsticker-groups-filename
- (not (string=
- (expand-file-name newsticker-groups-filename)
- (expand-file-name (concat newsticker-dir "/groups"))))
- (file-exists-p newsticker-groups-filename)
- (y-or-n-p
- (format-message
- (concat "Obsolete variable `newsticker-groups-filename' "
- "points to existing file \"%s\".\n"
- "Read it? ")
- newsticker-groups-filename))
- newsticker-groups-filename)
- (concat newsticker-dir "/groups")))
+ (filename (concat newsticker-dir "/groups"))
(buf (and (file-exists-p filename)
(find-file-noselect filename))))
- (and newsticker-groups-filename
- (file-exists-p newsticker-groups-filename)
- (y-or-n-p (format-message
- (concat "Delete the file \"%s\",\nto which the obsolete "
- "variable `newsticker-groups-filename' points ? ")
- newsticker-groups-filename))
- (delete-file newsticker-groups-filename))
(when buf
(set-buffer buf)
(goto-char (point-min))
diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el
index 6329e7660f7..c949915845b 100644
--- a/lisp/net/newsticker.el
+++ b/lisp/net/newsticker.el
@@ -54,7 +54,7 @@
;; as well as the following Atom formats:
;; * Atom 0.3
;; * Atom 1.0
-;; (see http://www.ietf.org/internet-drafts/draft-ietf-atompub-format-11.txt)
+;; (see https://www.ietf.org/internet-drafts/draft-ietf-atompub-format-11.txt)
;; That makes Newsticker.el an "Atom aggregator, "RSS reader", "RSS
;; aggregator", and "Feed Reader".
@@ -78,14 +78,6 @@
;; Installation
;; ------------
-;; If you are using Newsticker as part of GNU Emacs there is no need to
-;; perform any installation steps in order to use Newsticker. Otherwise
-;; place Newsticker in a directory where Emacs can find it. Add the
-;; following line to your init file:
-;; (add-to-list 'load-path "/path/to/newsticker/")
-;; (autoload 'newsticker-start "newsticker" "Emacs Newsticker" t)
-;; (autoload 'newsticker-show-news "newsticker" "Emacs Newsticker" t)
-
;; If you are using `imenu', which allows for navigating with the help of a
;; menu, you should add the following to your Emacs startup file
;; (`~/.emacs').
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index f84c1b3094f..2b300401650 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -311,9 +311,9 @@ See also: `network-security-protocol-checks' and `nsm-noninteractive'"
(map-values results)
"\n")
"\n")
- "\n* ")))))
- (delete-process process)
- (setq process nil)))
+ "\n* "))))))
+ (delete-process process)
+ (setq process nil))
(run-hook-with-args 'nsm-tls-post-check-functions
host port status settings results)))
process)
@@ -371,7 +371,7 @@ Reference:
Sheffer, Holz, Saint-Andre (May 2015). \"Recommendations for Secure
Use of Transport Layer Security (TLS) and Datagram Transport Layer
Security (DTLS)\", \"(4.1. General Guidelines)\"
-`https://tools.ietf.org/html/rfc7525\#section-4.1'"
+`https://tools.ietf.org/html/rfc7525#section-4.1'"
(let ((kx (plist-get status :key-exchange)))
(and (string-match "^\\bRSA\\b" kx)
(format-message
@@ -468,7 +468,7 @@ Reference:
GnuTLS authors (2018). \"GnuTLS Manual 4.3.3 Anonymous
authentication\",
-`https://www.gnutls.org/manual/gnutls.html\#Anonymous-authentication'"
+`https://www.gnutls.org/manual/gnutls.html#Anonymous-authentication'"
(let ((kx (plist-get status :key-exchange)))
(and (string-match "\\bANON\\b" kx)
(format-message
@@ -603,7 +603,7 @@ References:
full SHA-1\", `https://shattered.io/static/shattered.pdf'
[2]: Chromium Security Education TLS/SSL. \"Deprecated and Removed
Features (SHA-1 Certificate Signatures)\",
-`https://www.chromium.org/Home/chromium-security/education/tls\#TOC-SHA-1-Certificate-Signatures'
+`https://www.chromium.org/Home/chromium-security/education/tls#TOC-SHA-1-Certificate-Signatures'
[3]: Jones J.C (2017). \"The end of SHA-1 on the Public Web\",
`https://blog.mozilla.org/security/2017/02/23/the-end-of-sha-1-on-the-public-web/'
[4]: Apple Support (2017). \"Move to SHA-256 signed certificates to
@@ -964,6 +964,7 @@ protocol."
(defun nsm-write-settings ()
(with-temp-file nsm-settings-file
+ (insert ";;;; -*- mode: lisp-data -*-\n")
(insert "(\n")
(dolist (setting nsm-permanent-host-settings)
(insert " ")
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index ebcd21948bf..6d1cf2da71f 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -69,7 +69,6 @@
(require 'md4)
(require 'hmac-md5)
-(require 'calc)
(defgroup ntlm nil
"NTLM (NT LanManager) authentication."
@@ -133,32 +132,93 @@ is not given."
domain ;buffer field
))))
-(defun ntlm-compute-timestamp ()
- "Compute an NTLMv2 timestamp.
+;; Poor man's bignums: natural numbers represented as lists of bytes
+;; in little-endian order.
+;; When this code no longer needs to run on Emacs 26 or older, all this
+;; silliness should be simplified to use ordinary Lisp integers.
+
+(eval-and-compile ; for compile-time simplification
+ (defun ntlm--bignat-of-int (x)
+ "Convert the natural number X into a bignat."
+ (declare (pure t))
+ (and (not (zerop x))
+ (cons (logand x #xff) (ntlm--bignat-of-int (ash x -8)))))
+
+ (defun ntlm--bignat-add (a b &optional carry)
+ "Add the bignats A and B and the natural number CARRY."
+ (declare (pure t))
+ (and (or a b (and carry (not (zerop carry))))
+ (let ((s (+ (if a (car a) 0)
+ (if b (car b) 0)
+ (or carry 0))))
+ (cons (logand s #xff)
+ (ntlm--bignat-add (cdr a) (cdr b) (ash s -8))))))
+
+ (defun ntlm--bignat-shift-left (x n)
+ "Multiply the bignat X by 2^{8N}."
+ (declare (pure t))
+ (if (zerop n) x (ntlm--bignat-shift-left (cons 0 x) (1- n))))
+
+ (defun ntlm--bignat-mul-byte (a b)
+ "Multiply the bignat A with the byte B."
+ (declare (pure t))
+ (let ((p (mapcar (lambda (x) (* x b)) a)))
+ (ntlm--bignat-add
+ (mapcar (lambda (x) (logand x #xff)) p)
+ (cons 0 (mapcar (lambda (x) (ash x -8)) p)))))
+
+ (defun ntlm--bignat-mul (a b)
+ "Multiply the bignats A and B."
+ (declare (pure t))
+ (and a b (ntlm--bignat-add (ntlm--bignat-mul-byte a (car b))
+ (cons 0 (ntlm--bignat-mul a (cdr b))))))
+
+ (defun ntlm--bignat-of-string (s)
+ "Convert the string S (in decimal) to a bignat."
+ (declare (pure t))
+ (ntlm--bignat-of-digits (reverse (string-to-list s))))
+
+ (defun ntlm--bignat-of-digits (digits)
+ "Convert the little-endian list DIGITS of decimal digits to a bignat."
+ (declare (pure t))
+ (and digits
+ (ntlm--bignat-add
+ nil
+ (ntlm--bignat-mul-byte (ntlm--bignat-of-digits (cdr digits)) 10)
+ (- (car digits) ?0))))
+
+ (defun ntlm--bignat-to-int64 (x)
+ "Convert the bignat X to a 64-bit little-endian number as a string."
+ (declare (pure t))
+ (apply #'unibyte-string (mapcar (lambda (n) (or (nth n x) 0))
+ (number-sequence 0 7))))
+ )
+
+(defun ntlm--time-to-timestamp (time)
+ "Convert TIME to an NTLMv2 timestamp.
Return a unibyte string representing the number of tenths of a
microsecond since January 1, 1601 as a 64-bit little-endian
-signed integer."
- ;; FIXME: This can likely be significantly simplified using the new
- ;; bignums support!
- (let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)")
- (us-to-tenths-of-us "mul($3,10)")
- (ps-to-tenths-of-us "idiv($4,100000)")
- (tenths-of-us-since-jan-1-1601
- (apply #'calc-eval (concat "add(add(add("
- s-to-tenths-of-us ","
- us-to-tenths-of-us "),"
- ps-to-tenths-of-us "),"
- ;; tenths of microseconds between
- ;; 1601-01-01 and 1970-01-01
- "116444736000000000)")
- 'rawnum (time-convert nil 'list)))
- result-bytes)
- (dotimes (_byte 8)
- (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601)
- result-bytes)
- (setq tenths-of-us-since-jan-1-1601
- (calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601)))
- (apply #'unibyte-string (nreverse result-bytes))))
+signed integer. TIME must be on the form (HIGH LOW USEC PSEC)."
+ (let* ((s-hi (ntlm--bignat-of-int (nth 0 time)))
+ (s-lo (ntlm--bignat-of-int (nth 1 time)))
+ (s (ntlm--bignat-add (ntlm--bignat-shift-left s-hi 2) s-lo))
+ (us*10 (ntlm--bignat-of-int (* (nth 2 time) 10)))
+ (ps/1e5 (ntlm--bignat-of-int (/ (nth 3 time) 100000)))
+ ;; tenths of microseconds between 1601-01-01 and 1970-01-01
+ (to-unix-epoch (ntlm--bignat-of-string "116444736000000000"))
+ (tenths-of-us-since-jan-1-1601
+ (ntlm--bignat-add
+ (ntlm--bignat-add
+ (ntlm--bignat-add
+ (ntlm--bignat-mul s (ntlm--bignat-of-int 10000000))
+ us*10)
+ ps/1e5)
+ to-unix-epoch)))
+ (ntlm--bignat-to-int64 tenths-of-us-since-jan-1-1601)))
+
+(defun ntlm-compute-timestamp ()
+ "Current time as an NTLMv2 timestamp, as a unibyte string."
+ (ntlm--time-to-timestamp (time-convert nil 'list)))
(defun ntlm-generate-nonce ()
"Generate a random nonce, not to be used more than once.
diff --git a/lisp/net/puny.el b/lisp/net/puny.el
index 60a6c12e6c7..5c58fe02cbf 100644
--- a/lisp/net/puny.el
+++ b/lisp/net/puny.el
@@ -1,4 +1,4 @@
-;;; puny.el --- translate non-ASCII domain names to ASCII
+;;; puny.el --- translate non-ASCII domain names to ASCII -*- lexical-binding:t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
@@ -23,7 +23,7 @@
;;; Commentary:
;; Written by looking at
-;; http://stackoverflow.com/questions/183485/can-anyone-recommend-a-good-free-javascript-for-punycode-to-unicode-conversion
+;; https://stackoverflow.com/questions/183485/can-anyone-recommend-a-good-free-javascript-for-punycode-to-unicode-conversion
;;; Code:
@@ -35,7 +35,7 @@
For instance, \"fśf.org\" => \"xn--ff-2sa.org\"."
;; The vast majority of domain names are not IDNA domain names, so
;; add a check first to avoid doing unnecessary work.
- (if (string-match "\\'[[:ascii:]]+\\'" domain)
+ (if (string-match "\\`[[:ascii:]]+\\'" domain)
domain
(mapconcat 'puny-encode-string (split-string domain "[.]") ".")))
@@ -196,12 +196,12 @@ For instance \"xn--bcher-kva\" => \"bücher\"."
(cl-incf i)))
(buffer-string)))
-;; http://www.unicode.org/reports/tr39/#Restriction_Level_Detection
-;; http://www.unicode.org/reports/tr31/#Table_Candidate_Characters_for_Inclusion_in_Identifiers
+;; https://www.unicode.org/reports/tr39/#Restriction_Level_Detection
+;; https://www.unicode.org/reports/tr31/#Table_Candidate_Characters_for_Inclusion_in_Identifiers
(defun puny-highly-restrictive-string-p (string)
"Say whether STRING is \"highly restrictive\" in the Unicode IDNA sense.
-See http://www.unicode.org/reports/tr39/#Restriction_Level_Detection
+See https://www.unicode.org/reports/tr39/#Restriction_Level_Detection
for details. The main idea is that if you're mixing
scripts (like latin and cyrillic), you may confuse the user by
using homographs."
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index fff640bb675..63e6eedb200 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -56,7 +56,7 @@
:group 'applications)
(defcustom rcirc-server-alist
- '(("irc.freenode.net" :channels ("#rcirc")
+ '(("chat.freenode.net" :channels ("#rcirc")
;; Don't use the TLS port by default, in case gnutls is not available.
;; :port 7000 :encryption tls
))
@@ -254,7 +254,7 @@ Examples:
(\"bitlbee\" bitlbee \"robert\" \"sekrit\")
(\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\")
(\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))"
- :type '(alist :key-type (string :tag "Server")
+ :type '(alist :key-type (regexp :tag "Server")
:value-type (choice (list :tag "NickServ"
(const nickserv)
(string :tag "Nick")
@@ -359,9 +359,9 @@ If VAL is a coding system, it is used for both decoding and encoding
messages.
If VAL is a cons of coding systems, the car part is used for decoding,
and the cdr part is used for encoding."
- :type '(alist :key-type (choice (string :tag "Channel Regexp")
- (cons (string :tag "Channel Regexp")
- (string :tag "Server Regexp")))
+ :type '(alist :key-type (choice (regexp :tag "Channel Regexp")
+ (cons (regexp :tag "Channel Regexp")
+ (regexp :tag "Server Regexp")))
:value-type (choice coding-system
(cons (coding-system :tag "Decode")
(coding-system :tag "Encode")))))
@@ -625,7 +625,7 @@ SERVER-PLIST is the property list for the server."
(default (or (plist-get server-plist :encryption)
"plain")))
(intern
- (completing-read (format "Encryption (default %s): " default)
+ (completing-read (format-prompt "Encryption" default)
choices nil t nil nil default))))
(defun rcirc-keepalive ()
@@ -2421,7 +2421,7 @@ keywords when no KEYWORD is given."
(concat
"\\(?:"
;; Match paired parentheses, e.g. in Wikipedia URLs:
- "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]"
+ "[" chars punct "]+" "(" "[" chars punct "]+" ")" "[" chars "]"
"\\|"
"[" chars punct "]+" "[" chars "]"
"\\)"))
@@ -2626,12 +2626,16 @@ the only argument."
(and ;; nickserv
(string= sender "NickServ")
(string= target rcirc-nick)
- (member message
- (list
- (format "You are now identified for \C-b%s\C-b." rcirc-nick)
- (format "You are successfully identified as \C-b%s\C-b." rcirc-nick)
- "Password accepted - you are now recognized."
- )))
+ (cl-member
+ message
+ (list
+ (format "You are now identified for \C-b%s\C-b." rcirc-nick)
+ (format "You are successfully identified as \C-b%s\C-b."
+ rcirc-nick)
+ "Password accepted - you are now recognized.")
+ ;; The nick may have a different case, so match
+ ;; case-insensitively (Bug#39345).
+ :test #'cl-equalp))
(and ;; quakenet
(string= sender "Q")
(string= target rcirc-nick)
diff --git a/lisp/net/rfc2104.el b/lisp/net/rfc2104.el
index 50d54761b12..b008c9ac927 100644
--- a/lisp/net/rfc2104.el
+++ b/lisp/net/rfc2104.el
@@ -26,11 +26,9 @@
;;
;; Example:
;;
-;; (require 'md5)
;; (rfc2104-hash 'md5 64 16 "Jefe" "what do ya want for nothing?")
;; "750c783e6ab0b503eaa86e310a5db738"
;;
-;; (require 'sha1)
;; (rfc2104-hash 'sha1 64 20 "Jefe" "what do ya want for nothing?")
;; "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"
;;
diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el
index ec5b53ee917..6882c23d789 100644
--- a/lisp/net/sasl-ntlm.el
+++ b/lisp/net/sasl-ntlm.el
@@ -4,7 +4,7 @@
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Keywords: SASL, NTLM
-;; Version: 1.00
+;; Old-Version: 1.00
;; Created: February 2001
;; Package: sasl
diff --git a/lisp/net/sasl-scram-sha256.el b/lisp/net/sasl-scram-sha256.el
new file mode 100644
index 00000000000..e50a032c233
--- /dev/null
+++ b/lisp/net/sasl-scram-sha256.el
@@ -0,0 +1,59 @@
+;;; sasl-scram-sha256.el --- SCRAM-SHA-256 module for the SASL client framework -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Package: sasl
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Implement the SCRAM-SHA-256 mechanism from RFC 7677.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'sasl)
+(require 'hex-util)
+(require 'rfc2104)
+(require 'sasl-scram-rfc)
+
+;;; SCRAM-SHA-256
+
+(defconst sasl-scram-sha-256-steps
+ '(sasl-scram-client-first-message
+ sasl-scram-sha-256-client-final-message
+ sasl-scram-sha-256-authenticate-server))
+
+(defun sasl-scram-sha256 (object &optional start end binary)
+ (secure-hash 'sha256 object start end binary))
+
+(defun sasl-scram-sha-256-client-final-message (client step)
+ (sasl-scram--client-final-message
+ ;; HMAC-SHA256 uses block length 64 and hash length 32; see RFC 4634.
+ 'sasl-scram-sha256 64 32 client step))
+
+(defun sasl-scram-sha-256-authenticate-server (client step)
+ (sasl-scram--authenticate-server
+ 'sasl-scram-sha256 64 32 client step))
+
+(put 'sasl-scram-sha256 'sasl-mechanism
+ (sasl-make-mechanism "SCRAM-SHA-256" sasl-scram-sha-256-steps))
+
+(provide 'sasl-scram-sha256)
+
+;;; sasl-scram-sha256.el ends here
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index 4405c904cd3..ab118e1f982 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -35,8 +35,8 @@
;;; Code:
(defvar sasl-mechanisms
- '("SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
- "NTLM"))
+ '("SCRAM-SHA-256" "SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN"
+ "ANONYMOUS" "NTLM"))
(defvar sasl-mechanism-alist
'(("CRAM-MD5" sasl-cram)
@@ -45,6 +45,7 @@
("LOGIN" sasl-login)
("ANONYMOUS" sasl-anonymous)
("NTLM" sasl-ntlm)
+ ("SCRAM-SHA-256" sasl-scram-sha256)
("SCRAM-SHA-1" sasl-scram-rfc)))
(defvar sasl-unique-id-function #'sasl-unique-id-function)
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index 10d061fba20..f98ded4b0c6 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -23,7 +23,7 @@
;;; Commentary:
;; This package provides an implementation of the Secret Service API
-;; <http://www.freedesktop.org/wiki/Specifications/secret-storage-spec>.
+;; <https://www.freedesktop.org/wiki/Specifications/secret-storage-spec>.
;; This API is meant to make GNOME-Keyring- and KWallet-like daemons
;; available under a common D-BUS interface and thus increase
;; interoperability between GNOME, KDE and other applications having
@@ -795,8 +795,8 @@ In this mode, widgets represent the search results.
(set (make-local-variable 'revert-buffer-function)
#'secrets-show-collections)
;; When we toggle, we must set temporary widgets.
- (set (make-local-variable 'tree-widget-after-toggle-functions)
- '(secrets-tree-widget-after-toggle-function)))
+ (add-hook 'tree-widget-after-toggle-functions
+ #'secrets-tree-widget-after-toggle-function nil t))
;; It doesn't make sense to call it interactively.
(put 'secrets-mode 'disabled t)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 241180d471a..2e5dd5ffa50 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -95,15 +95,31 @@ If nil, don't draw horizontal table lines."
:type 'character)
(defcustom shr-width nil
- "Frame width to use for rendering.
+ "Window width to use for HTML rendering.
May either be an integer specifying a fixed width in characters,
-or nil, meaning that the full width of the window should be used.
-If `shr-use-fonts' is set, the mean character width is used to
-compute the pixel width, which is used instead."
+or nil, meaning use the full width of the window.
+If `shr-use-fonts' is set, the value is interpreted as a multiple
+of the mean character width of the default face's font.
+
+Also see `shr-max-width'."
:version "25.1"
:type '(choice (integer :tag "Fixed width in characters")
(const :tag "Use the width of the window" nil)))
+(defcustom shr-max-width 120
+ "Maximum text width to use for HTML rendering.
+May either be an integer specifying a fixed width in characters,
+or nil, meaning that there is no width limit.
+
+If `shr-use-fonts' is set, the value of this variable is
+interpreted as a multiple of the mean character width of the
+default face's font.
+
+If `shr-width' is non-nil, it overrides this variable."
+ :version "28.1"
+ :type '(choice (integer :tag "Fixed width in characters")
+ (const :tag "No width limit" nil)))
+
(defcustom shr-bullet "* "
"Bullet used for unordered lists.
Alternative suggestions are:
@@ -130,12 +146,20 @@ same domain as the main data."
:version "24.4"
:type 'boolean)
+(defcustom shr-offer-extend-specpdl t
+ "Non-nil means offer to extend the specpdl if the HTML nests deeply.
+Complicated HTML can require more nesting than the current specpdl
+size permits. If this variable is t, ask the user whether to increase
+the specpdl size. If nil, just give up."
+ :version "28.1"
+ :type 'boolean)
+
(defvar shr-content-function nil
"If bound, this should be a function that will return the content.
This is used for cid: URLs, and the function is called with the
cid: URL as the argument.")
-(defvar shr-put-image-function 'shr-put-image
+(defvar shr-put-image-function #'shr-put-image
"Function called to put image and alt string.")
(defface shr-strike-through '((t :strike-through t))
@@ -185,13 +209,15 @@ and other things:
(defvar shr-depth 0)
(defvar shr-warning nil)
(defvar shr-ignore-cache nil)
-(defvar shr-target-id nil)
(defvar shr-table-separator-length 1)
(defvar shr-table-separator-pixel-width 0)
(defvar shr-table-id nil)
(defvar shr-current-font nil)
(defvar shr-internal-bullet nil)
+(defvar shr-target-id nil
+ "Target fragment identifier anchor.")
+
(defvar shr-map
(let ((map (make-sparse-keymap)))
(define-key map "a" 'shr-show-alt-text)
@@ -265,30 +291,37 @@ DOM should be a parse tree as generated by
(shr-table-separator-pixel-width (shr-string-pixel-width "-"))
(shr-internal-bullet (cons shr-bullet
(shr-string-pixel-width shr-bullet)))
- (shr-internal-width (or (and shr-width
- (if (not shr-use-fonts)
- shr-width
- (* shr-width (frame-char-width))))
- ;; We need to adjust the available
- ;; width for when the user disables
- ;; the fringes, which will cause the
- ;; display engine usurp one column for
- ;; the continuation glyph.
- (if (not shr-use-fonts)
- (- (window-body-width) 1
- (if (and (null shr-width)
- (not (shr--have-one-fringe-p)))
- 0
- 1))
- (- (window-body-width nil t)
- (* 2 (frame-char-width))
- (if (and (null shr-width)
- (not (shr--have-one-fringe-p)))
- (* (frame-char-width) 2)
- 0)
- 1))))
+ (shr-internal-width
+ (if shr-width
+ ;; Specified width; use it.
+ (if (not shr-use-fonts)
+ shr-width
+ (* shr-width (frame-char-width)))
+ ;; Compute the width based on the window width. We need to
+ ;; adjust the available width for when the user disables
+ ;; the fringes, which will cause the display engine usurp
+ ;; one column for the continuation glyph.
+ (if (not shr-use-fonts)
+ (- (window-body-width) 1
+ (if (shr--have-one-fringe-p)
+ 1
+ 0))
+ (- (window-body-width nil t)
+ (* 2 (frame-char-width))
+ (if (shr--have-one-fringe-p)
+ 0
+ (* (frame-char-width) 2))
+ 1))))
(max-specpdl-size max-specpdl-size)
bidi-display-reordering)
+ ;; Adjust for max width specification.
+ (when (and shr-max-width
+ (not shr-width))
+ (setq shr-internal-width
+ (min shr-internal-width
+ (if shr-use-fonts
+ (* shr-max-width (frame-char-width))
+ shr-max-width))))
;; If the window was hscrolled for some reason, shr-fill-lines
;; below will misbehave, because it silently assumes that it
;; starts with a non-hscrolled window (vertical-motion will move
@@ -365,25 +398,20 @@ If the URL is already at the front of the kill ring act like
(shr-copy-url url)))
(defun shr--current-link-region ()
- (let ((current (get-text-property (point) 'shr-url))
- start)
- (save-excursion
- ;; Go to the beginning.
- (while (and (not (bobp))
- (equal (get-text-property (point) 'shr-url) current))
- (forward-char -1))
- (unless (equal (get-text-property (point) 'shr-url) current)
- (forward-char 1))
- (setq start (point))
- ;; Go to the end.
- (while (and (not (eobp))
- (equal (get-text-property (point) 'shr-url) current))
- (forward-char 1))
- (list start (point)))))
+ "Return the start and end positions of the URL at point, if any.
+Value is a pair of positions (START . END) if there is a non-nil
+`shr-url' text property at point; otherwise nil."
+ (when (get-text-property (point) 'shr-url)
+ (let* ((end (or (next-single-property-change (point) 'shr-url)
+ (point-max)))
+ (beg (or (previous-single-property-change end 'shr-url)
+ (point-min))))
+ (cons beg end))))
(defun shr--blink-link ()
- (let* ((region (shr--current-link-region))
- (overlay (make-overlay (car region) (cadr region))))
+ "Briefly fontify URL at point with the face `shr-selected-link'."
+ (when-let* ((region (shr--current-link-region))
+ (overlay (make-overlay (car region) (cdr region))))
(overlay-put overlay 'face 'shr-selected-link)
(run-at-time 1 nil (lambda ()
(delete-overlay overlay)))))
@@ -437,7 +465,7 @@ the URL of the image to the kill buffer instead."
(if (not url)
(message "No image under point")
(message "Inserting %s..." url)
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) (1- (point)) (point-marker))
t))))
@@ -463,7 +491,7 @@ size, and full-buffer size."
(when (> (- (point) start) 2)
(delete-region start (1- (point)))))
(message "Inserting %s..." url)
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) (1- (point)) (point-marker)
(list (cons 'size
(cond ((or (eq size 'default)
@@ -493,7 +521,7 @@ size, and full-buffer size."
((fboundp function)
(apply function dom args))
(t
- (apply 'shr-generic dom args)))))
+ (apply #'shr-generic dom args)))))
(defun shr-descend (dom)
(let ((function
@@ -507,7 +535,8 @@ size, and full-buffer size."
(start (point)))
;; shr uses many frames per nested node.
(if (and (> shr-depth (/ max-specpdl-size 15))
- (not (and (y-or-n-p "Too deeply nested to render properly; increase `max-specpdl-size'?")
+ (not (and shr-offer-extend-specpdl
+ (y-or-n-p "Too deeply nested to render properly; increase `max-specpdl-size'?")
(setq max-specpdl-size (* max-specpdl-size 2)))))
(setq shr-warning
"Not rendering the complete page because of too-deep nesting")
@@ -531,13 +560,16 @@ size, and full-buffer size."
(funcall function dom))
(t
(shr-generic dom)))
- (when (and shr-target-id
- (equal (dom-attr dom 'id) shr-target-id))
+ (when-let* ((id (dom-attr dom 'id)))
;; If the element was empty, we don't have anything to put the
;; anchor on. So just insert a dummy character.
(when (= start (point))
- (insert "*"))
- (put-text-property start (1+ start) 'shr-target-id shr-target-id))
+ (if (not (bolp))
+ (insert ? )
+ (insert ? )
+ (shr-mark-fill start))
+ (put-text-property (1- (point)) (point) 'display ""))
+ (put-text-property start (1+ start) 'shr-target-id id))
;; If style is set, then this node has set the color.
(when style
(shr-colorize-region
@@ -655,8 +687,11 @@ size, and full-buffer size."
(goto-char start)
(when (looking-at "[ \t\n\r]+")
(replace-match "" t t))
- (while (re-search-forward "[ \t\n\r]+" nil t)
+ (while (re-search-forward "[\t\n\r]+" nil t)
(replace-match " " t t))
+ (goto-char start)
+ (while (re-search-forward " +" nil t)
+ (replace-match " " t t))
(shr--translate-insertion-chars)
(goto-char (point-max)))
;; We may have removed everything we inserted if it was just
@@ -694,7 +729,8 @@ size, and full-buffer size."
(forward-char 1))))
(defun shr-fill-line ()
- (let ((shr-indentation (get-text-property (point) 'shr-indentation))
+ (let ((shr-indentation (or (get-text-property (point) 'shr-indentation)
+ shr-indentation))
(continuation (get-text-property
(point) 'shr-continuation-indentation))
start)
@@ -730,10 +766,11 @@ size, and full-buffer size."
(let ((gap-start (point))
(face (get-text-property (point) 'face)))
;; Extend the background to the end of the line.
- (if face
- (insert (propertize "\n" 'face (shr-face-background face)))
- (insert "\n"))
+ (insert ?\n)
(shr-indent)
+ (when face
+ (put-text-property gap-start (point)
+ 'face (shr-face-background face)))
(when (and (> (1- gap-start) (point-min))
(get-text-property (point) 'shr-url)
;; The link on both sides of the newline are the
@@ -838,7 +875,7 @@ size, and full-buffer size."
;; Always chop off anchors.
(when (string-match "#.*" url)
(setq url (substring url 0 (match-beginning 0))))
- ;; NB: <base href="" > URI may itself be relative to the document s URI
+ ;; NB: <base href=""> URI may itself be relative to the document's URI.
(setq url (shr-expand-url url))
(let* ((parsed (url-generic-parse-url url))
(local (url-filename parsed)))
@@ -911,6 +948,22 @@ size, and full-buffer size."
(looking-at " *$")))
;; We're already at a new paragraph; do nothing.
)
+ ((and (not (bolp))
+ (save-excursion
+ (beginning-of-line)
+ (looking-at " *$"))
+ (save-excursion
+ (forward-line -1)
+ (looking-at " *$"))
+ ;; Check all chars on the current line and see whether
+ ;; they're all placeholders.
+ (cl-loop for pos from (line-beginning-position) upto (1- (point))
+ unless (get-text-property pos 'shr-target-id)
+ return nil
+ finally return t))
+ ;; We have some invisible markers from <div id="foo"></div>;
+ ;; do nothing.
+ )
((and prefix
(= prefix (- (point) (line-beginning-position))))
;; Do nothing; we're at the start of a <li>.
@@ -935,12 +988,11 @@ size, and full-buffer size."
(defun shr-indent ()
(when (> shr-indentation 0)
- (insert
- (if (not shr-use-fonts)
- (make-string shr-indentation ?\s)
- (propertize " "
- 'display
- `(space :width (,shr-indentation)))))))
+ (if (not shr-use-fonts)
+ (insert-char ?\s shr-indentation)
+ (insert ?\s)
+ (put-text-property (1- (point)) (point)
+ 'display `(space :width (,shr-indentation))))))
(defun shr-fontize-dom (dom &rest types)
(let ((start (point)))
@@ -987,16 +1039,11 @@ the mouse click event."
(cond
((not url)
(message "No link under point"))
- ((string-match "^mailto:" url)
- (browse-url-mail url))
+ (external
+ (funcall browse-url-secondary-browser-function url)
+ (shr--blink-link))
(t
- (if external
- (progn
- (funcall browse-url-secondary-browser-function url)
- (shr--blink-link))
- (browse-url url (if new-window
- (not browse-url-new-window-flag)
- browse-url-new-window-flag)))))))
+ (browse-url url (xor new-window browse-url-new-window-flag))))))
(defun shr-save-contents (directory)
"Save the contents from URL in a file."
@@ -1005,7 +1052,7 @@ the mouse click event."
(if (not url)
(message "No link under point")
(url-retrieve (shr-encode-url url)
- 'shr-store-contents (list url directory)))))
+ #'shr-store-contents (list url directory)))))
(defun shr-store-contents (status url directory)
(unless (plist-get status :error)
@@ -1156,7 +1203,6 @@ width/height instead."
;; url-cache-extract autoloads url-cache.
(declare-function url-cache-create-filename "url-cache" (url))
-(autoload 'browse-url-mail "browse-url")
(defun shr-get-image-data (url)
"Get image data for URL.
@@ -1195,25 +1241,8 @@ Return a string with image data."
;; that are non-ASCII.
(shr-dom-to-xml
(libxml-parse-xml-region (point) (point-max)) 'utf-8)))
- ;; SVG images often do not have a specified foreground/background
- ;; color, so wrap them in styles.
- (when (and (display-images-p)
- (eq content-type 'image/svg+xml))
- (setq data (svg--wrap-svg data)))
(list data content-type)))
-(defun svg--wrap-svg (data)
- "Add a default foreground colour to SVG images."
- (let ((size (image-size (create-image data nil t :scaling 1) t)))
- (with-temp-buffer
- (insert
- (format
- "<svg xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:xi=\"http://www.w3.org/2001/XInclude\" style=\"color: %s;\" viewBox=\"0 0 %d %d\"> <xi:include href=\"data:image/svg+xml;base64,%s\"></xi:include></svg>"
- (face-foreground 'default)
- (car size) (cdr size)
- (base64-encode-string data t)))
- (buffer-string))))
-
(defun shr-image-displayer (content-function)
"Return a function to display an image.
CONTENT-FUNCTION is a function to retrieve an image for a cid url that
@@ -1230,7 +1259,7 @@ START, and END. Note that START and END should be markers."
(funcall shr-put-image-function
image (buffer-substring start end))
(delete-region (point) end))))
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) start end)
t t)))))
@@ -1265,7 +1294,9 @@ START, and END. Note that START and END should be markers."
(format "%s (%s)" iri title)
iri))
'follow-link t
- 'mouse-face 'highlight))
+ ;; Make separate regions not `eq' so that they'll get
+ ;; separate mouse highlights.
+ 'mouse-face (list 'highlight)))
;; Don't overwrite any keymaps that are already in the buffer (i.e.,
;; image keymaps).
(while (and start
@@ -1316,7 +1347,7 @@ ones, in case fg and bg are nil."
t))
(when bg
(add-face-text-property start end
- (list :background (car new-colors))
+ (list :background (car new-colors) :extend t)
t)))
new-colors)))
@@ -1438,7 +1469,7 @@ ones, in case fg and bg are nil."
(shr-fontize-dom dom 'underline))
(defun shr-tag-code (dom)
- (let ((shr-current-font 'default))
+ (let ((shr-current-font 'fixed-pitch))
(shr-generic dom)))
(defun shr-tag-tt (dom)
@@ -1495,14 +1526,13 @@ ones, in case fg and bg are nil."
(start (point))
shr-start)
(shr-generic dom)
- (when (and shr-target-id
- (equal (dom-attr dom 'name) shr-target-id))
- ;; We have a zero-length <a name="foo"> element, so just
- ;; insert... something.
+ (when-let* ((id (unless (dom-attr dom 'id) ; Handled by `shr-descend'.
+ (dom-attr dom 'name)))) ; Obsolete since HTML5.
+ ;; We have an empty element, so just insert... something.
(when (= start (point))
- (shr-ensure-newline)
- (insert " "))
- (put-text-property start (1+ start) 'shr-target-id shr-target-id))
+ (insert ?\s)
+ (put-text-property (1- (point)) (point) 'display ""))
+ (put-text-property start (1+ start) 'shr-target-id id))
(when url
(shr-urlify (or shr-start start) (shr-expand-url url) title))))
@@ -1677,7 +1707,7 @@ The preference is a float determined from `shr-prefer-media-type'."
(or alt "")))
(insert " ")
(url-queue-retrieve
- (shr-encode-url url) 'shr-image-fetched
+ (shr-encode-url url) #'shr-image-fetched
(list (current-buffer) start (set-marker (make-marker) (point))
(list :width width :height height))
t
@@ -2004,12 +2034,11 @@ BASE is the URL of the HTML being rendered."
(cond
((null tbodies)
dom)
- ((= (length tbodies) 1)
+ ((null (cdr tbodies))
(car tbodies))
(t
;; Table with multiple tbodies. Convert into a single tbody.
- `(tbody nil ,@(cl-reduce 'append
- (mapcar 'dom-non-text-children tbodies)))))))
+ `(tbody nil ,@(mapcan #'dom-non-text-children tbodies))))))
(defun shr--fix-tbody (tbody)
(nconc (list 'tbody (dom-attributes tbody))
@@ -2253,7 +2282,7 @@ flags that control whether to collect or render objects."
(not background))
(setq background (cadr elem))))
(and background
- (list :background background))))))
+ (list :background background :extend t))))))
(defun shr-expand-alignments (start end)
(while (< (setq start (next-single-property-change
@@ -2309,8 +2338,8 @@ flags that control whether to collect or render objects."
(dolist (column row)
(aset natural-widths i (max (aref natural-widths i) column))
(setq i (1+ i)))))
- (let ((extra (- (apply '+ (append suggested-widths nil))
- (apply '+ (append widths nil))
+ (let ((extra (- (apply #'+ (append suggested-widths nil))
+ (apply #'+ (append widths nil))
(* shr-table-separator-pixel-width (1+ (length widths)))))
(expanded-columns 0))
;; We have extra, unused space, so divide this space amongst the
@@ -2585,12 +2614,28 @@ flags that control whether to collect or render objects."
i))
(defun shr-max-columns (dom)
- (let ((max 0))
+ (let ((max 0)
+ (this 0)
+ (rowspans nil))
(dolist (row (dom-children dom))
(when (and (not (stringp row))
(eq (dom-tag row) 'tr))
- (setq max (max max (+ (shr-count row 'td)
- (shr-count row 'th))))))
+ (setq this 0)
+ (dolist (column (dom-children row))
+ (when (and (not (stringp column))
+ (memq (dom-tag column) '(td th)))
+ (setq this (+ 1 this (length rowspans)))
+ ;; We have a rowspan, which we emulate later in rendering
+ ;; by adding an extra column to the following rows.
+ (when-let* ((span (dom-attr column 'rowspan)))
+ (push (string-to-number span) rowspans))))
+ (setq max (max max this)))
+ ;; Count down the rowspans in effect.
+ (let ((new nil))
+ (dolist (span rowspans)
+ (when (> span 1)
+ (push (1- span) new)))
+ (setq rowspans new)))
max))
(provide 'shr)
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index d6dc008e87a..c5f44917919 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -1,4 +1,4 @@
-;;; sieve-mode.el --- Sieve code editing commands for Emacs
+;;; sieve-mode.el --- Sieve code editing commands for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
@@ -26,11 +26,6 @@
;; sieve-style #-comments and a lightly hacked syntax table. It was
;; strongly influenced by awk-mode.el.
;;
-;; Put something similar to the following in your .emacs to use this file:
-;;
-;; (load "~/lisp/sieve")
-;; (setq auto-mode-alist (cons '("\\.siv\\'" . sieve-mode) auto-mode-alist))
-;;
;; References:
;;
;; RFC 3028,
diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el
index 441e6b14f7b..76d9ced58a6 100644
--- a/lisp/net/snmp-mode.el
+++ b/lisp/net/snmp-mode.el
@@ -24,9 +24,7 @@
;; INTRODUCTION
;; ------------
-;; This package provides a major mode for editing SNMP MIBs. It
-;; provides all the modern Emacs 19 bells and whistles: default
-;; fontification via font-lock, imenu search functions, etc.
+;; This package provides a major mode for editing SNMP MIBs.
;;
;; SNMP mode also uses tempo, a textual boilerplate insertion package
;; distributed with Emacs, to add in boilerplate SNMP MIB structures.
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index e3c38052a51..241ce9efcb3 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -5,7 +5,7 @@
;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Created: December, 2009
-;; Version: 3.1.5
+;; Version: 3.2.0
;; Keywords: soap, web-services, comm, hypermedia
;; Package: soap-client
;; Homepage: https://github.com/alex-hhh/emacs-soap-client
@@ -551,30 +551,77 @@ This is a specialization of `soap-encode-value' for
(soap-validate-xs-basic-type value-string type)
(insert value-string)))))
-;; Inspired by rng-xsd-convert-date-time.
-(defun soap-decode-date-time (date-time-string datatype)
+(defun soap-decode-date-time (date-time-string &optional datatype)
"Decode DATE-TIME-STRING as DATATYPE.
DATE-TIME-STRING should be in ISO 8601 basic or extended format.
-DATATYPE is one of dateTime, time, date, gYearMonth, gYear,
-gMonthDay, gDay or gMonth.
-
-Return a list in a format (SEC MINUTE HOUR DAY MONTH YEAR
-SEC-FRACTION DATATYPE ZONE). This format is meant to be similar
-to that returned by `decode-time' (and compatible with
-`encode-time'). The differences are the SEC (seconds)
-field is always an integer, the DOW (day-of-week) field
-is replaced with SEC-FRACTION, a float representing the
-fractional seconds, and the DST (daylight savings time) field is
-replaced with DATATYPE, a symbol representing the XSD primitive
-datatype. This symbol can be used to determine which fields
-apply and which don't when it's not already clear from context.
-For example a datatype of `time' means the year, month and day
+DATATYPE can be omitted, or one of the symbols dateTime, time,
+date, gYearMonth, gYear, gMonthDay, gDay, or gMonth. If Emacs is
+a version that supports fractional seconds, DATATYPE can also be
+dateTime-subsecond, or time-subsecond. On older versions of
+Emacs (prior to 27.1), which do not support fractional seconds,
+leaving DATATYPE nil means that subseconds in DATE-TIME-STRING
+will be ignored.
+
+Return a list in a format identical or similar to that returned
+by `decode-time'. The returned format is always compatible with
+`encode-time'. If DATATYPE is omitted or nil, this function will
+return a list that has exactly the same format as that returned
+by `decode-time'.
+
+Note that on versions of Emacs that predate support for
+fractional seconds, `encode-time' will not notice the SUBSECOND
+field so it must be handled specially.
+
+The formats returned by this function are as follows, where _
+means \"should be ignored\":
+
+ DATATYPE | Return format
+------------+----------------------------------------------------------------
+ nil | (SECOND MINUTE HOUR DAY MONTH YEAR DOW DST UTCOFF)
+ dateTime | (SECOND MINUTE HOUR DAY MONTH YEAR SUBSECOND dateTime UTCOFF)
+ time | (SECOND MINUTE HOUR _ _ _ SUBSECOND time _)
+ date | (_ _ _ DAY MONTH YEAR _ date _)
+ gYearMonth | (_ _ _ _ MONTH YEAR _ gYearMonth _)
+ gYear | (_ _ _ _ _ YEAR _ gYear _)
+ gMonthDay | (_ _ _ DAY MONTH _ _ gMonthDay _)
+ gDay | (_ _ _ DAY _ _ _ gDay _)
+ gMonth | (_ _ _ _ MONTH _ _ gMonth _)
+
+When DATATYPE is dateTime or time, the DOW (day-of-week) field is
+replaced with SUBSECOND, a float representing the fractional
+seconds, and the DST (daylight savings time) field is replaced
+with DATATYPE, a symbol representing the XSD primitive datatype.
+This symbol can be used to determine which fields apply and which
+do not, when it is not already clear from context. For example a
+datatype of `time' means the year, month, day and time zone
fields should be ignored.
-This function will throw an error if DATE-TIME-STRING represents
-a leap second, since the XML Schema 1.1 standard explicitly
-disallows them."
- (let* ((datetime-regexp (cadr (get datatype 'rng-xsd-convert)))
+New code that depends on Emacs 27.1 or newer anyway, and that
+wants dateTime or time but with the first argument with subsecond
+resolution, i.e., (TICKS . HZ), can set DATATYPE to
+dateTime-subsecond or time-subsecond respectively. This function
+throws an error if dateTime-subsecond or time-subsecond is
+specified when Emacs does not support subsecond resolution.
+
+This function throws an error if DATE-TIME-STRING represents a
+leap second, since the XML Schema 1.1 standard does not support
+representing leap seconds."
+ (let* ((new-decode-time (condition-case nil
+ (not (null
+ (with-no-warnings (decode-time nil nil t))))
+ (wrong-number-of-arguments)))
+ (new-decode-time-second nil)
+ (no-support "This Emacs version does not support %s")
+ (datetime-regexp-type
+ (cl-case datatype
+ ((dateTime-subsecond time-subsecond)
+ (if new-decode-time
+ (intern (replace-regexp-in-string
+ "-subsecond" "" (symbol-name datatype)))
+ (error (format no-support (symbol-name datatype)))))
+ ((nil) 'dateTime)
+ (otherwise datatype)))
+ (datetime-regexp (cadr (get datetime-regexp-type 'rng-xsd-convert)))
(year-sign (progn
(string-match datetime-regexp date-time-string)
(match-string 1 date-time-string)))
@@ -585,6 +632,7 @@ disallows them."
(minute (match-string 6 date-time-string))
(second (match-string 7 date-time-string))
(second-fraction (match-string 8 date-time-string))
+ (time-zone nil)
(has-time-zone (match-string 9 date-time-string))
(time-zone-sign (match-string 10 date-time-string))
(time-zone-hour (match-string 11 date-time-string))
@@ -605,11 +653,28 @@ disallows them."
(if hour (string-to-number hour) 0))
(setq minute
(if minute (string-to-number minute) 0))
+ (when new-decode-time
+ (setq new-decode-time-second
+ (if second
+ (if second-fraction
+ (let* ((second-fraction-significand
+ (replace-regexp-in-string "\\." "" second-fraction))
+ (hertz
+ (expt 10 (length second-fraction-significand)))
+ (ticks (+ (* hertz (string-to-number second))
+ (string-to-number
+ second-fraction-significand))))
+ (cons ticks hertz))
+ (cons second 1)))))
(setq second
(if second (string-to-number second) 0))
(setq second-fraction
(if second-fraction
- (float (string-to-number second-fraction))
+ (progn
+ (when (and (not datatype) (not new-decode-time))
+ (message
+ "soap-decode-date-time: Discarding fractional seconds"))
+ (float (string-to-number second-fraction)))
0.0))
(setq has-time-zone (and has-time-zone t))
(setq time-zone-sign
@@ -618,6 +683,14 @@ disallows them."
(if time-zone-hour (string-to-number time-zone-hour) 0))
(setq time-zone-minute
(if time-zone-minute (string-to-number time-zone-minute) 0))
+ (setq time-zone (if has-time-zone
+ (* (rng-xsd-time-to-seconds
+ time-zone-hour
+ time-zone-minute
+ 0)
+ time-zone-sign)
+ ;; UTC.
+ 0))
(unless (and
;; XSD does not allow year 0.
(> year 0)
@@ -635,18 +708,22 @@ disallows them."
(>= time-zone-minute 0)
(<= time-zone-minute 59))
(error "Invalid or unsupported time: %s" date-time-string))
- ;; Return a value in a format similar to that returned by decode-time, and
- ;; suitable for (apply #'encode-time ...).
- ;; FIXME: Nobody uses this idiosyncratic value. Perhaps stop returning it?
- (list second minute hour day month year second-fraction datatype
- (if has-time-zone
- (* (rng-xsd-time-to-seconds
- time-zone-hour
- time-zone-minute
- 0)
- time-zone-sign)
- ;; UTC.
- 0))))
+ ;; Return a value in a format identical or similar to that
+ ;; returned by decode-time, and always suitable for (apply
+ ;; #'encode-time ...).
+ (if datatype
+ (list (if (memq datatype '(dateTime-subsecond time-subsecond))
+ new-decode-time-second
+ second)
+ minute hour day month year second-fraction datatype time-zone)
+ (let ((time
+ (apply
+ #'encode-time (list
+ (if new-decode-time new-decode-time-second second)
+ minute hour day month year nil nil time-zone))))
+ (if new-decode-time
+ (with-no-warnings (decode-time time nil t))
+ (decode-time time))))))
(defun soap-decode-xs-basic-type (type node)
"Use TYPE, a `soap-xs-basic-type', to decode the contents of NODE.
@@ -1716,6 +1793,7 @@ This is a specialization of `soap-encode-value' for
((and (not (eq indicator 'choice))
(= instance-count 0)
(not (soap-xs-element-optional? element))
+ (not (soap-xs-complex-type-optional? type))
(and (soap-xs-complex-type-p element-type)
(not (soap-xs-complex-type-optional-p
element-type))))
@@ -2000,7 +2078,7 @@ This is a specialization of `soap-decode-type' for
soap-headers ; list of (message part use)
soap-body ; message parts present in the body
use ; 'literal or 'encoded, see
- ; http://www.w3.org/TR/wsdl#_soap:body
+ ; https://www.w3.org/TR/wsdl#_soap:body
)
(cl-defstruct (soap-binding (:include soap-element))
@@ -2033,6 +2111,8 @@ This is a specialization of `soap-decode-type' for
;; Add the XSD types to the wsdl document
(let ((ns (soap-make-xs-basic-types
+ ;; The following string is a name and not an URL, so
+ ;; the "http:" should not be changed.
"http://www.w3.org/2001/XMLSchema" "xsd")))
(soap-wsdl-add-namespace ns wsdl)
(soap-wsdl-add-alias "xsd" (soap-namespace-name ns) wsdl))
@@ -2918,8 +2998,6 @@ reference multiRef parts which are external to RESPONSE-NODE."
;;;; SOAP type encoding
-;; FIXME: Use `cl-defmethod' (but this requires Emacs-25).
-
(defun soap-encode-attributes (value type)
"Encode XML attributes for VALUE according to TYPE.
This is a generic function which determines the attribute encoder
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 84fc5dccace..9b22a5083fb 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -235,11 +235,10 @@
(let ((num 0)
(retval ""))
(mapc
- (function
- (lambda (x)
- (if (fboundp (cdr (cdr x)))
- (setq retval (format "%s%c" retval (car x))
- num (1+ num)))))
+ (lambda (x)
+ (if (fboundp (cdr (cdr x)))
+ (setq retval (format "%s%c" retval (car x))
+ num (1+ num))))
(reverse socks-authentication-methods))
(format "%c%s" num retval)))
diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el
index e8c0c1bbdf4..29c415e6a65 100644
--- a/lisp/net/telnet.el
+++ b/lisp/net/telnet.el
@@ -149,7 +149,7 @@ rejecting one login and prompting again for a username and password.")
((string-match "passw" string)
(telnet-filter proc string)
(setq telnet-count 0)
- (process-send-string proc (concat (comint-read-noecho "Password: " t)
+ (process-send-string proc (concat (read-passwd "Password: ")
telnet-new-line))
(clear-this-command-keys))
(t (telnet-check-software-type-initialize string)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 2f20c8d93e5..7cdb7ebf536 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -57,15 +57,27 @@ It is used for TCP/IP devices."
"When this method name is used, forward all calls to Android Debug Bridge.")
;;;###tramp-autoload
-(defcustom tramp-adb-prompt
- "^[[:digit:]]*|?[[:alnum:]\e;[]*@?[[:alnum:]]*[^#\\$]*[#\\$][[:space:]]"
+(defcustom tramp-adb-prompt "^[^#$\n\r]*[#$][[:space:]]"
"Regexp used as prompt in almquist shell."
:type 'regexp
- :version "24.4"
+ :version "28.1"
:group 'tramp)
+(eval-and-compile
+ (defconst tramp-adb-ls-date-year-regexp
+ "[[:digit:]]\\{4\\}-[[:digit:]]\\{2\\}-[[:digit:]]\\{2\\}"
+ "Regexp for date year format in ls output."))
+
+(eval-and-compile
+ (defconst tramp-adb-ls-date-time-regexp
+ "[[:digit:]]\\{2\\}:[[:digit:]]\\{2\\}"
+ "Regexp for date time format in ls output."))
+
(defconst tramp-adb-ls-date-regexp
- "[[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]][0-9][0-9]:[0-9][0-9][[:space:]]"
+ (concat
+ "[[:space:]]" tramp-adb-ls-date-year-regexp
+ "[[:space:]]" tramp-adb-ls-date-time-regexp
+ "[[:space:]]")
"Regexp for date format in ls output.")
(defconst tramp-adb-ls-toolbox-regexp
@@ -75,7 +87,8 @@ It is used for TCP/IP devices."
"[[:space:]]*\\([^[:space:]]+\\)" ; \2 username
"[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
"[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
- "[[:space:]]+\\([-[:digit:]]+[[:space:]][:[:digit:]]+\\)" ; \5 date
+ "[[:space:]]+\\(" tramp-adb-ls-date-year-regexp
+ "[[:space:]]" tramp-adb-ls-date-time-regexp "\\)" ; \5 date
"[[:space:]]\\(.*\\)$") ; \6 filename
"Regexp for ls output.")
@@ -83,8 +96,10 @@ It is used for TCP/IP devices."
(tramp--with-startup
(add-to-list 'tramp-methods
`(,tramp-adb-method
- (tramp-tmpdir "/data/local/tmp")
- (tramp-default-port 5555)))
+ (tramp-login-program ,tramp-adb-program)
+ (tramp-login-args (("shell")))
+ (tramp-tmpdir "/data/local/tmp")
+ (tramp-default-port 5555)))
(add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil ""))
@@ -138,7 +153,7 @@ It is used for TCP/IP devices."
(file-selinux-context . tramp-handle-file-selinux-context)
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-adb-handle-file-system-info)
- (file-truename . tramp-adb-handle-file-truename)
+ (file-truename . tramp-handle-file-truename)
(file-writable-p . tramp-adb-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
@@ -162,6 +177,8 @@ It is used for TCP/IP devices."
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . ignore)
+ (tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
@@ -183,10 +200,9 @@ It is used for TCP/IP devices."
"Invoke the ADB handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of
ARGUMENTS to pass to the OPERATION."
- (let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) arguments))
- (tramp-run-real-handler operation arguments))))
+ (if-let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) arguments))
+ (tramp-run-real-handler operation arguments)))
;;;###tramp-autoload
(tramp--with-startup
@@ -216,11 +232,10 @@ ARGUMENTS to pass to the OPERATION."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*[^[:space:]]+"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
+ (concat "[[:space:]]*[^[:space:]]+"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"))
;; The values are given as 1k numbers, so we must change
;; them to number of bytes.
(list (* 1024 (string-to-number (match-string 1)))
@@ -230,105 +245,6 @@ ARGUMENTS to pass to the OPERATION."
(string-to-number (match-string 2))))
(* 1024 (string-to-number (match-string 3)))))))))
-;; This is derived from `tramp-sh-handle-file-truename'. Maybe the
-;; code could be shared?
-(defun tramp-adb-handle-file-truename (filename)
- "Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
- ;; Quote properly.
- (funcall
- (if (tramp-compat-file-name-quoted-p filename)
- #'tramp-compat-file-name-quote #'identity)
- (with-parsed-tramp-file-name
- (tramp-compat-file-name-unquote (expand-file-name filename)) nil
- (tramp-make-tramp-file-name
- v
- (with-tramp-file-property v localname "file-truename"
- (let (result) ; result steps in reverse order
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (let* ((steps (split-string localname "/" 'omit))
- (localnamedir (tramp-run-real-handler
- 'file-name-as-directory (list localname)))
- (is-dir (string= localname localnamedir))
- (thisstep nil)
- (numchase 0)
- ;; Don't make the following value larger than
- ;; necessary. People expect an error message in a
- ;; timely fashion when something is wrong; otherwise
- ;; they might think that Emacs is hung. Of course,
- ;; correctness has to come first.
- (numchase-limit 20)
- symlink-target)
- (while (and steps (< numchase numchase-limit))
- (setq thisstep (pop steps))
- (tramp-message
- v 5 "Check %s"
- (string-join
- (append '("") (reverse result) (list thisstep)) "/"))
- (setq symlink-target
- (tramp-compat-file-attribute-type
- (file-attributes
- (tramp-make-tramp-file-name
- v
- (string-join
- (append
- '("") (reverse result) (list thisstep)) "/")))))
- (cond ((string= "." thisstep)
- (tramp-message v 5 "Ignoring step `.'"))
- ((string= ".." thisstep)
- (tramp-message v 5 "Processing step `..'")
- (pop result))
- ((stringp symlink-target)
- ;; It's a symlink, follow it.
- (tramp-message v 5 "Follow symlink to %s" symlink-target)
- (setq numchase (1+ numchase))
- (when (file-name-absolute-p symlink-target)
- (setq result nil))
- ;; If the symlink was absolute, we'll get a string
- ;; like "/user@host:/some/target"; extract the
- ;; "/some/target" part from it.
- (when (tramp-tramp-file-p symlink-target)
- (unless (tramp-equal-remote filename symlink-target)
- (tramp-error
- v 'file-error
- "Symlink target `%s' on wrong host" symlink-target))
- (setq symlink-target localname))
- (setq steps
- (append (split-string symlink-target "/" 'omit)
- steps)))
- (t
- ;; It's a file.
- (setq result (cons thisstep result)))))
- (when (>= numchase numchase-limit)
- (tramp-error
- v 'file-error
- "Maximum number (%d) of symlinks exceeded" numchase-limit))
- (setq result (reverse result))
- ;; Combine list to form string.
- (setq result
- (if result
- (string-join (cons "" result) "/")
- "/"))
- (when (and is-dir (or (string-empty-p result)
- (not (string= (substring result -1) "/"))))
- (setq result (concat result "/"))))
-
- ;; Detect cycle.
- (when (and (file-symlink-p filename)
- (string-equal result localname))
- (tramp-error
- v 'file-error
- "Apparent cycle of symbolic links for %s" filename))
- ;; If the resulting localname looks remote, we must quote it
- ;; for security reasons.
- (when (file-remote-p result)
- (setq result (tramp-compat-file-name-quote result 'top)))
- (tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result)))))))
-
(defun tramp-adb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
@@ -372,7 +288,9 @@ ARGUMENTS to pass to the OPERATION."
(if (eq id-format 'integer) 0 uid)
(if (eq id-format 'integer) 0 gid)
tramp-time-dont-know ; atime
- (date-to-time date) ; mtime
+ ;; `date-to-time' checks `iso8601-parse', which might fail.
+ (let (signal-hook-function)
+ (date-to-time date)) ; mtime
tramp-time-dont-know ; ctime
size
mod-string
@@ -383,7 +301,7 @@ ARGUMENTS to pass to the OPERATION."
file-properties)))
(defun tramp-adb-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format _count)
+ (directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -393,8 +311,8 @@ ARGUMENTS to pass to the OPERATION."
(with-parsed-tramp-file-name (expand-file-name directory) nil
(copy-tree
(with-tramp-file-property
- v localname (format "directory-files-and-attributes-%s-%s-%s-%s"
- full match id-format nosort)
+ v localname (format "directory-files-and-attributes-%s-%s-%s-%s-%s"
+ full match id-format nosort count)
(with-current-buffer (tramp-get-buffer v)
(when (tramp-adb-send-command-and-check
v (format "%s -a -l %s"
@@ -424,11 +342,17 @@ ARGUMENTS to pass to the OPERATION."
(unless nosort
(setq result
(sort result (lambda (x y) (string< (car x) (car y))))))
- (delq nil
- (mapcar (lambda (x)
- (if (or (not match) (string-match-p match (car x)))
- x))
- result)))))))))
+
+ (setq result (delq nil
+ (mapcar
+ (lambda (x) (if (or (not match)
+ (string-match-p
+ match (car x)))
+ x))
+ result)))
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+ result)))))))
(defun tramp-adb-get-ls-command (vec)
"Determine `ls' command and its arguments."
@@ -451,21 +375,6 @@ ARGUMENTS to pass to the OPERATION."
"ls --color=never")
(t "ls"))))
-(defun tramp-adb--gnu-switches-to-ash (switches)
- "Almquist shell can't handle multiple arguments.
-Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"."
- (split-string
- (apply #'concat
- (mapcar (lambda (s)
- (replace-regexp-in-string
- "\\(.\\)" " -\\1" (replace-regexp-in-string "^-" "" s)))
- ;; FIXME: Warning about removed switches (long and non-dash).
- (delq nil
- (mapcar
- (lambda (s)
- (and (not (string-match-p "\\(^--\\|^[^-]\\)" s)) s))
- switches))))))
-
(defun tramp-adb-sh-fix-ls-output (&optional sort-by-time)
"Insert dummy 0 in empty size columns.
Android's \"ls\" command doesn't insert size column for directories:
@@ -475,10 +384,16 @@ Emacs dired can't find files."
(goto-char (point-min))
(while
(search-forward-regexp
- "[[:space:]]\\([[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]]\\)" nil t)
+ (eval-when-compile
+ (concat
+ "[[:space:]]"
+ "\\([[:space:]]" tramp-adb-ls-date-year-regexp "[[:space:]]\\)"))
+ nil t)
(replace-match "0\\1" "\\1" nil)
;; Insert missing "/".
- (when (looking-at-p "[0-9][0-9]:[0-9][0-9][[:space:]]+$")
+ (when (looking-at-p
+ (eval-when-compile
+ (concat tramp-adb-ls-date-time-regexp "[[:space:]]+$")))
(end-of-line)
(insert "/")))
;; Sort entries.
@@ -528,27 +443,25 @@ Emacs dired can't find files."
(and parents (file-directory-p dir)))
(tramp-error v 'file-error "Couldn't make directory %s" dir))))
-(defun tramp-adb-handle-delete-directory (directory &optional recursive _trash)
+(defun tramp-adb-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
- (setq directory (expand-file-name directory))
- (with-parsed-tramp-file-name (file-truename directory) nil
- (tramp-flush-directory-properties v localname))
- (with-parsed-tramp-file-name directory nil
- (tramp-flush-directory-properties v localname)
+ (tramp-skeleton-delete-directory directory recursive trash
(tramp-adb-barf-unless-okay
v (format "%s %s"
(if recursive "rm -r" "rmdir")
(tramp-shell-quote-argument localname))
"Couldn't delete %s" directory)))
-(defun tramp-adb-handle-delete-file (filename &optional _trash)
+(defun tramp-adb-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
- (tramp-adb-barf-unless-okay
- v (format "rm %s" (tramp-shell-quote-argument localname))
- "Couldn't delete %s" filename)))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash filename)
+ (tramp-adb-barf-unless-okay
+ v (format "rm %s" (tramp-shell-quote-argument localname))
+ "Couldn't delete %s" filename))))
(defun tramp-adb-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
@@ -589,9 +502,10 @@ Emacs dired can't find files."
(with-tramp-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
;; "adb pull ..." does not always return an error code.
- (when (or (tramp-adb-execute-adb-command
- v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
- (not (file-exists-p tmpfile)))
+ (unless
+ (and (tramp-adb-execute-adb-command
+ v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
+ (file-exists-p tmpfile))
(ignore-errors (delete-file tmpfile))
(tramp-error
v 'file-error "Cannot make local copy of file `%s'" filename))
@@ -644,8 +558,8 @@ But handle the case, if the \"test\" command is not available."
v 3 (format-message
"Moving tmp file `%s' to `%s'" tmpfile filename)
(unwind-protect
- (when (tramp-adb-execute-adb-command
- v "push" tmpfile (tramp-compat-file-name-unquote localname))
+ (unless (tramp-adb-execute-adb-command
+ v "push" tmpfile (tramp-compat-file-name-unquote localname))
(tramp-error v 'file-error "Cannot write: `%s'" filename))
(delete-file tmpfile)))
@@ -661,8 +575,9 @@ But handle the case, if the \"test\" command is not available."
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
(set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (or (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))
+ (current-time))))
;; The end.
(when (and (null noninteractive)
@@ -670,13 +585,16 @@ But handle the case, if the \"test\" command is not available."
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))
-(defun tramp-adb-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
- (tramp-adb-send-command-and-check v (format "chmod %o %s" mode localname))))
+ ;; ADB shell does not support "chmod -h".
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-flush-file-properties v localname)
+ (tramp-adb-send-command-and-check
+ v (format "chmod %o %s" mode (tramp-shell-quote-argument localname))))))
-(defun tramp-adb-handle-set-file-times (filename &optional time _flag)
+(defun tramp-adb-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
@@ -685,21 +603,23 @@ But handle the case, if the \"test\" command is not available."
(tramp-compat-time-equal-p time tramp-time-dont-know))
(current-time)
time))
+ (nofollow (if (eq flag 'nofollow) "-h" ""))
(quoted-name (tramp-shell-quote-argument localname)))
;; Older versions of toybox 'touch' mishandle nanoseconds and/or
;; trailing "Z", so fall back on plain seconds if nanoseconds+Z
;; fails. Also, fall back on old POSIX 'touch -t' if 'touch -d'
;; (introduced in POSIX.1-2008) fails.
(tramp-adb-send-command-and-check
- v (format (concat "touch -d %s %s 2>/dev/null || "
- "touch -d %s %s 2>/dev/null || "
- "touch -t %s %s")
- (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
- quoted-name
- (format-time-string "%Y-%m-%dT%H:%M:%S" time t)
- quoted-name
- (format-time-string "%Y%m%d%H%M.%S" time t)
- quoted-name)))))
+ v (format
+ (concat "touch -d %s %s %s 2>/dev/null || "
+ "touch -d %s %s %s 2>/dev/null || "
+ "touch -t %s %s %s")
+ (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
+ nofollow quoted-name
+ (format-time-string "%Y-%m-%dT%H:%M:%S" time t)
+ nofollow quoted-name
+ (format-time-string "%Y%m%d%H%M.%S" time t)
+ nofollow quoted-name)))))
(defun tramp-adb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -722,7 +642,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -742,46 +662,45 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(tramp-shell-quote-argument l2))
"Error copying %s to %s" filename newname))
- (let ((tmpfile (file-local-copy filename)))
-
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (and (file-directory-p newname)
- (tramp-compat-directory-name-p newname))
- (setq newname
- (expand-file-name
- (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- ;; We must also flush the cache of the directory,
- ;; because `file-attributes' reads the values from
- ;; there.
- (tramp-flush-file-properties v localname)
- (when (tramp-adb-execute-adb-command
+ (if-let ((tmpfile (file-local-copy filename)))
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (and (file-directory-p newname)
+ (directory-name-p newname))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ ;; We must also flush the cache of the directory,
+ ;; because `file-attributes' reads the values from
+ ;; there.
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-adb-execute-adb-command
v "push"
(tramp-compat-file-name-unquote filename)
(tramp-compat-file-name-unquote localname))
- (tramp-error
- v 'file-error
- "Cannot copy `%s' `%s'" filename newname)))))))))
+ (tramp-error
+ v 'file-error
+ "Cannot copy `%s' `%s'" filename newname))))))))
;; KEEP-DATE handling.
(when keep-date
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))))
(defun tramp-adb-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -804,7 +723,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -973,164 +892,168 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; The complete STDERR buffer is available only when the process has
;; terminated.
(defun tramp-adb-handle-make-process (&rest args)
- "Like `make-process' for Tramp files."
- (when args
- (with-parsed-tramp-file-name (expand-file-name default-directory) nil
- (let ((name (plist-get args :name))
- (buffer (plist-get args :buffer))
- (command (plist-get args :command))
- (coding (plist-get args :coding))
- (noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
- (filter (plist-get args :filter))
- (sentinel (plist-get args :sentinel))
- (stderr (plist-get args :stderr)))
- (unless (stringp name)
- (signal 'wrong-type-argument (list #'stringp name)))
- (unless (or (null buffer) (bufferp buffer) (stringp buffer))
- (signal 'wrong-type-argument (list #'stringp buffer)))
- (unless (consp command)
- (signal 'wrong-type-argument (list #'consp command)))
- (unless (or (null coding)
- (and (symbolp coding) (memq coding coding-system-list))
- (and (consp coding)
- (memq (car coding) coding-system-list)
- (memq (cdr coding) coding-system-list)))
- (signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
- (signal 'wrong-type-argument (list #'symbolp connection-type)))
- (unless (or (null filter) (functionp filter))
- (signal 'wrong-type-argument (list #'functionp filter)))
- (unless (or (null sentinel) (functionp sentinel))
- (signal 'wrong-type-argument (list #'functionp sentinel)))
- (unless (or (null stderr) (bufferp stderr) (stringp stderr))
- (signal 'wrong-type-argument (list #'stringp stderr)))
- (when (and (stringp stderr) (tramp-tramp-file-p stderr)
- (not (tramp-equal-remote default-directory stderr)))
- (signal 'file-error (list "Wrong stderr" stderr)))
-
- (let* ((buffer
- (if buffer
- (get-buffer-create buffer)
- ;; BUFFER can be nil. We use a temporary buffer.
- (generate-new-buffer tramp-temp-buffer-name)))
- ;; STDERR can also be a file name.
- (tmpstderr
- (and stderr
- (if (and (stringp stderr) (tramp-tramp-file-p stderr))
- (tramp-unquote-file-local-name stderr)
- (tramp-make-tramp-temp-file v))))
- (remote-tmpstderr
- (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
- (program (car command))
- (args (cdr command))
- (command
- (format "cd %s && exec %s %s"
- (tramp-shell-quote-argument localname)
- (if tmpstderr (format "2>'%s'" tmpstderr) "")
- (mapconcat #'tramp-shell-quote-argument
- (cons program args) " ")))
- (tramp-process-connection-type
- (or (null program) tramp-process-connection-type))
- (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
- (name1 name)
- (i 0))
-
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- (setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
-
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise, `make-process'
- ;; could be called on the local host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save BUFFER
- ;; contents. Clear also the modification time;
- ;; otherwise we might be interrupted by
- ;; `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t))
- (clear-visited-file-modtime)
- (narrow-to-region (point-max) (point-max))
- ;; We call `tramp-adb-maybe-open-connection', in
- ;; order to cleanup the prompt afterwards.
- (tramp-adb-maybe-open-connection v)
- (delete-region (point-min) (point-max))
- ;; Send the command.
- (let* ((p (tramp-get-connection-process v)))
- (tramp-adb-send-command v command nil t) ; nooutput
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- ;; Set query flag and process marker for this
- ;; process. We ignore errors, because the
- ;; process could have finished already.
- (ignore-errors
- (set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point)))
- ;; We must flush them here already; otherwise
- ;; `rename-file', `delete-file' or
- ;; `insert-file-contents' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Copy tmpstderr file.
- (when (and (stringp stderr)
- (not (tramp-tramp-file-p stderr)))
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (rename-file remote-tmpstderr stderr))))
- ;; Read initial output. Remove the first line,
- ;; which is the command echo.
- (while
- (progn
- (goto-char (point-min))
- (not (re-search-forward "[\n]" nil t)))
- (tramp-accept-process-output p 0))
- (delete-region (point-min) (point))
- ;; Provide error buffer. This shows only
- ;; initial error messages; messages arriving
- ;; later on will be inserted when the process
- ;; is deleted. The temporary file will exist
- ;; until the process is deleted.
- (when (bufferp stderr)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit))
- ;; Delete tmpstderr file.
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit nil nil 'replace))
- (delete-file remote-tmpstderr))))
- ;; Return process.
- p))))
-
- ;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer (tramp-get-connection-process v) nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer"))))))))
+ "Like `make-process' for Tramp files.
+If connection property \"direct-async-process\" is non-nil, an
+alternative implementation will be used."
+ (if (tramp-direct-async-process-p args)
+ (apply #'tramp-handle-make-process args)
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((name (plist-get args :name))
+ (buffer (plist-get args :buffer))
+ (command (plist-get args :command))
+ (coding (plist-get args :coding))
+ (noquery (plist-get args :noquery))
+ (connection-type (plist-get args :connection-type))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ (stderr (plist-get args :stderr)))
+ (unless (stringp name)
+ (signal 'wrong-type-argument (list #'stringp name)))
+ (unless (or (null buffer) (bufferp buffer) (stringp buffer))
+ (signal 'wrong-type-argument (list #'stringp buffer)))
+ (unless (consp command)
+ (signal 'wrong-type-argument (list #'consp command)))
+ (unless (or (null coding)
+ (and (symbolp coding) (memq coding coding-system-list))
+ (and (consp coding)
+ (memq (car coding) coding-system-list)
+ (memq (cdr coding) coding-system-list)))
+ (signal 'wrong-type-argument (list #'symbolp coding)))
+ (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (functionp filter))
+ (signal 'wrong-type-argument (list #'functionp filter)))
+ (unless (or (null sentinel) (functionp sentinel))
+ (signal 'wrong-type-argument (list #'functionp sentinel)))
+ (unless (or (null stderr) (bufferp stderr) (stringp stderr))
+ (signal 'wrong-type-argument (list #'stringp stderr)))
+ (when (and (stringp stderr) (tramp-tramp-file-p stderr)
+ (not (tramp-equal-remote default-directory stderr)))
+ (signal 'file-error (list "Wrong stderr" stderr)))
+
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ ;; STDERR can also be a file name.
+ (tmpstderr
+ (and stderr
+ (if (and (stringp stderr) (tramp-tramp-file-p stderr))
+ (tramp-unquote-file-local-name stderr)
+ (tramp-make-tramp-temp-file v))))
+ (remote-tmpstderr
+ (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (program (car command))
+ (args (cdr command))
+ (command
+ (format "cd %s && exec %s %s"
+ (tramp-shell-quote-argument localname)
+ (if tmpstderr (format "2>'%s'" tmpstderr) "")
+ (mapconcat #'tramp-shell-quote-argument
+ (cons program args) " ")))
+ (tramp-process-connection-type
+ (or (null program) tramp-process-connection-type))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0))
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process'
+ ;; could be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification time;
+ ;; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ ;; We call `tramp-adb-maybe-open-connection',
+ ;; in order to cleanup the prompt afterwards.
+ (tramp-adb-maybe-open-connection v)
+ (delete-region (point-min) (point-max))
+ ;; Send the command.
+ (let* ((p (tramp-get-connection-process v)))
+ (tramp-adb-send-command v command nil t) ; nooutput
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ ;; Set query flag and process marker for
+ ;; this process. We ignore errors, because
+ ;; the process could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (null noquery))
+ (set-marker (process-mark p) (point)))
+ ;; We must flush them here already;
+ ;; otherwise `rename-file', `delete-file' or
+ ;; `insert-file-contents' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ ;; Copy tmpstderr file.
+ (when (and (stringp stderr)
+ (not (tramp-tramp-file-p stderr)))
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (rename-file remote-tmpstderr stderr))))
+ ;; Read initial output. Remove the first
+ ;; line, which is the command echo.
+ (while
+ (progn
+ (goto-char (point-min))
+ (not (re-search-forward "[\n]" nil t)))
+ (tramp-accept-process-output p 0))
+ (delete-region (point-min) (point))
+ ;; Provide error buffer. This shows only
+ ;; initial error messages; messages arriving
+ ;; later on will be inserted when the
+ ;; process is deleted. The temporary file
+ ;; will exist until the process is deleted.
+ (when (bufferp stderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit nil nil 'replace))
+ (delete-file remote-tmpstderr))))
+ ;; Return process.
+ p))))
+
+ ;; Save exit.
+ (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer (tramp-get-connection-process v) nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp))
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")))))))))
(defun tramp-adb-handle-exec-path ()
"Like `exec-path' for Tramp files."
(append
(with-parsed-tramp-file-name default-directory nil
- (with-tramp-connection-property v "remote-path"
+ (with-tramp-connection-property (tramp-get-process v) "remote-path"
(tramp-adb-send-command v "echo \\\"$PATH\\\"")
(split-string
(with-current-buffer (tramp-get-connection-buffer v)
@@ -1145,11 +1068,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
"Return full host name from VEC to be used in shell execution.
E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
a host name \"R38273882DE\" returns \"R38273882DE\"."
- ;; Sometimes this is called before there is a connection process
- ;; yet. In order to work with the connection cache, we flush all
- ;; unwanted entries first.
- (tramp-flush-connection-properties nil)
- (with-tramp-connection-property (tramp-get-connection-process vec) "device"
+ (with-tramp-connection-property (tramp-get-process vec) "device"
(let* ((host (tramp-file-name-host vec))
(port (tramp-file-name-port-or-default vec))
(devices (mapcar #'cadr (tramp-adb-parse-device-names nil))))
@@ -1167,10 +1086,10 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
;; Try to connect device.
((and tramp-adb-connect-if-not-connected
(not (zerop (length host)))
- (not (tramp-adb-execute-adb-command
- vec "connect"
- (replace-regexp-in-string
- tramp-prefix-port-format ":" host))))
+ (tramp-adb-execute-adb-command
+ vec "connect"
+ (replace-regexp-in-string
+ tramp-prefix-port-format ":" host)))
;; When new device connected, running other adb command (e.g.
;; adb shell) immediately will fail. To get around this
;; problem, add sleep 0.1 second here.
@@ -1180,18 +1099,18 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
vec 'file-error "Could not find device %s" host)))))))
(defun tramp-adb-execute-adb-command (vec &rest args)
- "Return nil on success error-output on failure."
+ "Execute an adb command.
+Insert the result into the connection buffer. Return nil on
+error and non-nil on success."
(when (and (> (length (tramp-file-name-host vec)) 0)
;; The -s switch is only available for ADB device commands.
(not (member (car args) '("connect" "disconnect"))))
(setq args (append (list "-s" (tramp-adb-get-device vec)) args)))
- (with-temp-buffer
- (prog1
- (unless
- (zerop
- (apply #'tramp-call-process vec tramp-adb-program nil t nil args))
- (buffer-string))
- (tramp-message vec 6 "%s" (buffer-string)))))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Clean up the buffer. We cannot call `erase-buffer' because
+ ;; narrowing might be in effect.
+ (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)))
+ (zerop (apply #'tramp-call-process vec tramp-adb-program nil t nil args))))
(defun tramp-adb-find-test-command (vec)
"Check whether the ash has a builtin \"test\" command.
@@ -1203,25 +1122,30 @@ This happens for Android >= 4.0."
(defun tramp-adb-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC."
- (unless neveropen (tramp-adb-maybe-open-connection vec))
- (tramp-message vec 6 "%s" command)
- (tramp-send-string vec command)
- (unless nooutput
- ;; FIXME: Race condition.
- (tramp-adb-wait-for-output (tramp-get-connection-process vec))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (save-excursion
- (goto-char (point-min))
- ;; We can't use stty to disable echo of command. stty is said
- ;; to be added to toybox 0.7.6. busybox shall have it, but this
- ;; isn't used any longer for Android.
- (delete-matching-lines (regexp-quote command))
- ;; When the local machine is W32, there are still trailing ^M.
- ;; There must be a better solution by setting the correct coding
- ;; system, but this requires changes in core Tramp.
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" nil nil))))))
+ (if (string-match-p "[[:multibyte:]]" command)
+ ;; Multibyte codepoints with four bytes are not supported at
+ ;; least by toybox.
+ (tramp-adb-execute-adb-command vec "shell" command)
+
+ (unless neveropen (tramp-adb-maybe-open-connection vec))
+ (tramp-message vec 6 "%s" command)
+ (tramp-send-string vec command)
+ (unless nooutput
+ ;; FIXME: Race condition.
+ (tramp-adb-wait-for-output (tramp-get-connection-process vec))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (save-excursion
+ (goto-char (point-min))
+ ;; We can't use stty to disable echo of command. stty is said
+ ;; to be added to toybox 0.7.6. busybox shall have it, but this
+ ;; isn't used any longer for Android.
+ (delete-matching-lines (regexp-quote command))
+ ;; When the local machine is W32, there are still trailing ^M.
+ ;; There must be a better solution by setting the correct coding
+ ;; system, but this requires changes in core Tramp.
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" nil nil)))))))
(defun tramp-adb-send-command-and-check (vec command &optional exit-status)
"Run COMMAND and check its exit status.
@@ -1236,7 +1160,7 @@ the exit status."
(format "%s; echo tramp_exit_status $?" command)
"echo tramp_exit_status $?"))
(with-current-buffer (tramp-get-connection-buffer vec)
- (unless (tramp-search-regexp "tramp_exit_status [0-9]+")
+ (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
@@ -1340,12 +1264,24 @@ connection if a previous connection has died for some reason."
(tramp-adb-send-command
vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
+ ;; Disable line editing.
+ (tramp-adb-send-command
+ vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs")
+
+ ;; Dump option settings in the traces.
+ (when (>= tramp-verbose 9)
+ (tramp-adb-send-command vec "set -o"))
+
;; Check whether the properties have been changed. If
;; yes, this is a strong indication that we must expire all
;; connection properties. We start again.
(tramp-message vec 5 "Checking system information")
(tramp-adb-send-command
- vec "echo \\\"`getprop ro.product.model` `getprop ro.product.version` `getprop ro.build.version.release`\\\"")
+ vec
+ (concat
+ "echo \\\"`getprop ro.product.model` "
+ "`getprop ro.product.version` "
+ "`getprop ro.build.version.release`\\\""))
(let ((old-getprop
(tramp-get-connection-property vec "getprop" nil))
(new-getprop
@@ -1369,7 +1305,8 @@ connection if a previous connection has died for some reason."
(tramp-adb-send-command vec (format "su %s" user))
(unless (tramp-adb-send-command-and-check vec nil)
(delete-process p)
- (tramp-flush-file-property vec "" "su-command-p")
+ ;; Do not flush, we need the nil value.
+ (tramp-set-file-property vec "" "su-command-p" nil)
(tramp-error
vec 'file-error "Cannot switch to user `%s'" user)))
@@ -1403,4 +1340,9 @@ connection if a previous connection has died for some reason."
(provide 'tramp-adb)
+;;; TODO:
+;;
+;; * Support file names with multibyte codepoints. Use as fallback
+;; "adb shell COMMAND".
+;;
;;; tramp-adb.el ends here
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 611247ef2cb..931a9717310 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -163,7 +163,7 @@
"List of suffixes which indicate a file archive.
It must be supported by libarchive(3).")
-;; <http://unix-memo.readthedocs.io/en/latest/vfs.html>
+;; <https://unix-memo.readthedocs.io/en/latest/vfs.html>
;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar, mtree, iso9660, compress.
;; read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab.
@@ -279,7 +279,9 @@ It must be supported by libarchive(3).")
(start-file-process . tramp-archive-handle-not-implemented)
;; `substitute-in-file-name' performed by default handler.
(temporary-file-directory . tramp-archive-handle-temporary-file-directory)
- ;; `tramp-set-file-uid-gid' performed by default handler.
+ (tramp-get-remote-gid . ignore)
+ (tramp-get-remote-uid . ignore)
+ (tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
@@ -353,7 +355,7 @@ arguments to pass to the OPERATION."
(add-to-list 'file-name-handler-alist
(cons (tramp-archive-autoload-file-name-regexp)
#'tramp-archive-autoload-file-name-handler))
- (put 'tramp-archive-autoload-file-name-handler 'safe-magic t))))
+ (put #'tramp-archive-autoload-file-name-handler 'safe-magic t))))
;;;###autoload
(progn
@@ -369,7 +371,7 @@ arguments to pass to the OPERATION."
(tramp-register-archive-file-name-handler)
;; Mark `operations' the handler is responsible for.
-(put 'tramp-archive-file-name-handler 'operations
+(put #'tramp-archive-file-name-handler 'operations
(mapcar #'car tramp-archive-file-name-handler-alist))
;; `tramp-archive-file-name-handler' must be placed before `url-file-handler'.
@@ -520,13 +522,16 @@ offered."
(declare (debug (form symbolp body))
(indent 2))
(let ((bindings
- (mapcar (lambda (elem)
- `(,(if var (intern (format "%s-%s" var elem)) elem)
- (,(intern (format "tramp-file-name-%s" elem))
- ,(or var 'v))))
- `,(cons
- 'archive
- (delete 'hop (tramp-compat-tramp-file-name-slots))))))
+ (mapcar
+ (lambda (elem)
+ `(,(if var (intern (format "%s-%s" var elem)) elem)
+ (,(intern (format "tramp-file-name-%s" elem))
+ ,(or var 'v))))
+ (cons
+ 'archive
+ (delete
+ 'hop
+ (cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name))))))))
`(let* ((,(or var 'v) (tramp-archive-dissect-file-name ,filename))
,@bindings)
;; We don't know which of those vars will be used, so we bind them all,
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 0f2d7a1800f..970e2eea0ac 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -31,13 +31,13 @@
;; a process, has a unique cache. We distinguish 4 kind of caches,
;; depending on the key:
;;
-;; - localname is NIL. This are reusable properties. Examples:
+;; - localname is nil. These are reusable properties. Examples:
;; "remote-shell" identifies the POSIX shell to be called on the
;; remote host, or "perl" is the command to be called on the remote
;; host when starting a Perl script. These properties are saved in
;; the file `tramp-persistency-file-name'.
;;
-;; - localname is a string. This are temporary properties, which are
+;; - localname is a string. These are temporary properties, which are
;; related to the file localname is referring to. Examples:
;; "file-exists-p" is t or nil, depending on the file existence, or
;; "file-attributes" caches the result of the function
@@ -45,21 +45,32 @@
;; expire after `remote-file-name-inhibit-cache' seconds if this
;; variable is set.
;;
-;; - The key is a process. This are temporary properties related to
+;; - The key is a process. These are temporary properties related to
;; an open connection. Examples: "scripts" keeps shell script
;; definitions already sent to the remote shell, "last-cmd-time" is
;; the time stamp a command has been sent to the remote process.
;;
-;; - The key is nil. This are temporary properties related to the
+;; - The key is nil. These are temporary properties related to the
;; local machine. Examples: "parse-passwd" and "parse-group" keep
;; the results of parsing "/etc/passwd" and "/etc/group",
;; "{uid,gid}-{integer,string}" are the local uid and gid, and
;; "locale" is the used shell locale.
+;;
+;; - The key is `tramp-cache-undefined'. All functions return the
+;; expected values, but nothing is cached.
;; Some properties are handled special:
;;
;; - "process-name", "process-buffer" and "first-password-request" are
-;; not saved in the file `tramp-persistency-file-name'.
+;; not saved in the file `tramp-persistency-file-name', although
+;; being connection properties related to a `tramp-file-name'
+;; structure.
+;;
+;; - Reusable properties, which should not be saved, are kept in the
+;; process key retrieved by `tramp-get-process' (the main connection
+;; process). Other processes could reuse these properties, avoiding
+;; recomputation when a new asynchronous process is created by
+;; `make-process'. Examples are "remote-path" or "device" (tramp-adb.el).
;;; Code:
@@ -96,25 +107,31 @@ details see the info pages."
(defvar tramp-cache-data-changed nil
"Whether persistent cache data have been changed.")
+;;;###tramp-autoload
+(defconst tramp-cache-undefined 'undef
+ "The symbol marking undefined hash keys and values.")
+
(defun tramp-get-hash-table (key)
"Return the hash table for KEY.
If it doesn't exist yet, it is created and initialized with
-matching entries of `tramp-connection-properties'."
- (or (gethash key tramp-cache-data)
- (let ((hash
- (puthash key (make-hash-table :test #'equal) tramp-cache-data)))
- (when (tramp-file-name-p key)
- (dolist (elt tramp-connection-properties)
- (when (string-match-p
- (or (nth 0 elt) "")
- (tramp-make-tramp-file-name key 'noloc 'nohop))
- (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
- hash)))
+matching entries of `tramp-connection-properties'.
+If KEY is `tramp-cache-undefined', don't create anything, and return nil."
+ (unless (eq key tramp-cache-undefined)
+ (or (gethash key tramp-cache-data)
+ (let ((hash
+ (puthash key (make-hash-table :test #'equal) tramp-cache-data)))
+ (when (tramp-file-name-p key)
+ (dolist (elt tramp-connection-properties)
+ (when (string-match-p
+ (or (nth 0 elt) "")
+ (tramp-make-tramp-file-name key 'noloc 'nohop))
+ (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
+ hash))))
;;;###tramp-autoload
(defun tramp-get-file-property (key file property default)
"Get the PROPERTY of FILE from the cache context of KEY.
-Returns DEFAULT if not set."
+Return DEFAULT if not set."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
@@ -122,31 +139,32 @@ Returns DEFAULT if not set."
(tramp-run-real-handler #'directory-file-name (list file))
(tramp-file-name-hop key) nil)
(let* ((hash (tramp-get-hash-table key))
- (value (when (hash-table-p hash) (gethash property hash))))
- (if ;; We take the value only if there is any, and
- ;; `remote-file-name-inhibit-cache' indicates that it is still
- ;; valid. Otherwise, DEFAULT is set.
- (and (consp value)
+ (cached (and (hash-table-p hash) (gethash property hash)))
+ (cached-at (and (consp cached) (format-time-string "%T" (car cached))))
+ (value default)
+ cache-used)
+
+ (when ;; We take the value only if there is any, and
+ ;; `remote-file-name-inhibit-cache' indicates that it is
+ ;; still valid. Otherwise, DEFAULT is set.
+ (and (consp cached)
(or (null remote-file-name-inhibit-cache)
(and (integerp remote-file-name-inhibit-cache)
(time-less-p
- ;; `current-time' can be nil once we get rid of Emacs 24.
- (current-time)
- (time-add
- (car value)
- ;; `seconds-to-time' can be removed once we get
- ;; rid of Emacs 24.
- (seconds-to-time remote-file-name-inhibit-cache))))
+ nil
+ (time-add (car cached) remote-file-name-inhibit-cache)))
(and (consp remote-file-name-inhibit-cache)
(time-less-p
- remote-file-name-inhibit-cache (car value)))))
- (setq value (cdr value))
- (setq value default))
+ remote-file-name-inhibit-cache (car cached)))))
+ (setq value (cdr cached)
+ cache-used t))
- (tramp-message key 8 "%s %s %s" file property value)
+ (tramp-message
+ key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
+ file property value remote-file-name-inhibit-cache cache-used cached-at)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
- (val (or (bound-and-true-p var)
+ (val (or (numberp (bound-and-true-p var))
(progn
(add-hook 'tramp-cache-unload-hook
(lambda () (makunbound var)))
@@ -157,7 +175,7 @@ Returns DEFAULT if not set."
;;;###tramp-autoload
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
-Returns VALUE."
+Return VALUE."
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
key (copy-tramp-file-name key))
@@ -170,7 +188,7 @@ Returns VALUE."
(tramp-message key 8 "%s %s %s" file property value)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-set-count-" property)))
- (val (or (bound-and-true-p var)
+ (val (or (numberp (bound-and-true-p var))
(progn
(add-hook 'tramp-cache-unload-hook
(lambda () (makunbound var)))
@@ -202,13 +220,11 @@ Returns VALUE."
key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) file
(tramp-file-name-hop key) nil)
- (maphash
- (lambda (property _value)
- (when (string-match-p
- "^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
- property)
- (tramp-flush-file-property key file property)))
- (tramp-get-hash-table key)))))
+ (dolist (property (hash-table-keys (tramp-get-hash-table key)))
+ (when (string-match-p
+ "^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
+ property)
+ (tramp-flush-file-property key file property))))))
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)
@@ -239,14 +255,12 @@ Remove also properties of all files in subdirectories."
#'directory-file-name (list directory)))
(truename (tramp-get-file-property key directory "file-truename" nil)))
(tramp-message key 8 "%s" directory)
- (maphash
- (lambda (key _value)
- (when (and (tramp-file-name-p key)
- (stringp (tramp-file-name-localname key))
- (string-match-p (regexp-quote directory)
- (tramp-file-name-localname key)))
- (remhash key tramp-cache-data)))
- tramp-cache-data)
+ (dolist (key (hash-table-keys tramp-cache-data))
+ (when (and (tramp-file-name-p key)
+ (stringp (tramp-file-name-localname key))
+ (string-match-p (regexp-quote directory)
+ (tramp-file-name-localname key)))
+ (remhash key tramp-cache-data)))
;; Remove file properties of symlinks.
(when (and (stringp truename)
(not (string-equal directory (directory-file-name truename))))
@@ -292,8 +306,9 @@ This is suppressed for temporary buffers."
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
-used to cache connection properties of the local machine. If the
-value is not set for the connection, returns DEFAULT."
+used to cache connection properties of the local machine.
+If KEY is `tramp-cache-undefined', or if the value is not set for
+the connection, return DEFAULT."
;; Unify key by removing localname and hop from `tramp-file-name'
;; structure. Work with a copy in order to avoid side effects.
(when (tramp-file-name-p key)
@@ -301,15 +316,19 @@ value is not set for the connection, returns DEFAULT."
(setf (tramp-file-name-localname key) nil
(tramp-file-name-hop key) nil))
(let* ((hash (tramp-get-hash-table key))
- (value
- ;; If the key is an auxiliary process object, check whether
- ;; the process is still alive.
- (if (and (processp key) (not (process-live-p key)))
- default
- (if (hash-table-p hash)
- (gethash property hash default)
- default))))
- (tramp-message key 7 "%s %s" property value)
+ (cached (if (hash-table-p hash)
+ (gethash property hash tramp-cache-undefined)
+ tramp-cache-undefined))
+ (value default)
+ cache-used)
+
+ (when (and (not (eq cached tramp-cache-undefined))
+ ;; If the key is an auxiliary process object, check
+ ;; whether the process is still alive.
+ (not (and (processp key) (not (process-live-p key)))))
+ (setq value cached
+ cache-used t))
+ (tramp-message key 7 "%s %s; cache used: %s" property value cache-used)
value))
;;;###tramp-autoload
@@ -317,19 +336,22 @@ value is not set for the connection, returns DEFAULT."
"Set the named PROPERTY of a connection to VALUE.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
-used to cache connection properties of the local machine.
-PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
+used to cache connection properties of the local machine. If KEY
+is `tramp-cache-undefined', nothing is set.
+PROPERTY is set persistent when KEY is a `tramp-file-name' structure.
+Return VALUE."
;; Unify key by removing localname and hop from `tramp-file-name'
;; structure. Work with a copy in order to avoid side effects.
(when (tramp-file-name-p key)
(setq key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) nil
(tramp-file-name-hop key) nil))
- (let ((hash (tramp-get-hash-table key)))
- (puthash property value hash)
- (setq tramp-cache-data-changed t)
- (tramp-message key 7 "%s %s" property value)
- value))
+ (when-let ((hash (tramp-get-hash-table key)))
+ (puthash property value hash))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
+ (tramp-message key 7 "%s %s" property value)
+ value)
;;;###tramp-autoload
(defun tramp-connection-property-p (key property)
@@ -337,7 +359,8 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
used to cache connection properties of the local machine."
- (not (eq (tramp-get-connection-property key property 'undef) 'undef)))
+ (not (eq (tramp-get-connection-property key property tramp-cache-undefined)
+ tramp-cache-undefined)))
;;;###tramp-autoload
(defun tramp-flush-connection-property (key property)
@@ -352,8 +375,10 @@ PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
(setq key (copy-tramp-file-name key))
(setf (tramp-file-name-localname key) nil
(tramp-file-name-hop key) nil))
- (remhash property (tramp-get-hash-table key))
- (setq tramp-cache-data-changed t)
+ (when-let ((hash (tramp-get-hash-table key)))
+ (remhash property hash))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
(tramp-message key 7 "%s" property))
;;;###tramp-autoload
@@ -370,12 +395,10 @@ used to cache connection properties of the local machine."
(tramp-file-name-hop key) nil))
(tramp-message
key 7 "%s %s" key
- (let ((hash (gethash key tramp-cache-data))
- properties)
- (when (hash-table-p hash)
- (maphash (lambda (x _y) (push x properties)) hash))
- properties))
- (setq tramp-cache-data-changed t)
+ (when-let ((hash (gethash key tramp-cache-data)))
+ (hash-table-keys hash)))
+ (setq tramp-cache-data-changed
+ (or tramp-cache-data-changed (tramp-file-name-p key)))
(remhash key tramp-cache-data))
;;;###tramp-autoload
@@ -386,20 +409,15 @@ used to cache connection properties of the local machine."
(maphash
(lambda (key value)
;; Remove text properties from KEY and VALUE.
- ;; `cl-struct-slot-*' functions exist since Emacs 25 only; we
- ;; ignore errors.
(when (tramp-file-name-p key)
- ;; (dolist
- ;; (slot
- ;; (mapcar #'car (cdr (cl-struct-slot-info 'tramp-file-name))))
- ;; (when (stringp (cl-struct-slot-value 'tramp-file-name slot key))
- ;; (setf (cl-struct-slot-value 'tramp-file-name slot key)
- ;; (substring-no-properties
- ;; (cl-struct-slot-value 'tramp-file-name slot key))))))
- (dotimes (i (length key))
- (when (stringp (elt key i))
- (setf (elt key i) (substring-no-properties (elt key i))))))
- (when (stringp key)
+ (dolist
+ (slot
+ (mapcar #'car (cdr (cl-struct-slot-info 'tramp-file-name))))
+ (when (stringp (cl-struct-slot-value 'tramp-file-name slot key))
+ (setf (cl-struct-slot-value 'tramp-file-name slot key)
+ (substring-no-properties
+ (cl-struct-slot-value 'tramp-file-name slot key))))))
+ (when (stringp key)
(setq key (substring-no-properties key)))
(when (stringp value)
(setq value (substring-no-properties value)))
@@ -421,18 +439,18 @@ used to cache connection properties of the local machine."
;;;###tramp-autoload
(defun tramp-list-connections ()
"Return all known `tramp-file-name' structs according to `tramp-cache'."
- (let (result tramp-verbose)
- (maphash
- (lambda (key _value)
- (when (and (tramp-file-name-p key)
- (null (tramp-file-name-localname key))
- (tramp-connection-property-p key "process-buffer"))
- (push key result)))
- tramp-cache-data)
- result))
+ (let ((tramp-verbose 0))
+ (delq nil (mapcar
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (null (tramp-file-name-localname key))
+ (tramp-connection-property-p key "process-buffer")
+ key))
+ (hash-table-keys tramp-cache-data)))))
(defun tramp-dump-connection-properties ()
- "Write persistent connection properties into file `tramp-persistency-file-name'."
+ "Write persistent connection properties into file \
+`tramp-persistency-file-name'."
;; We shouldn't fail, otherwise Emacs might not be able to be closed.
(ignore-errors
(when (and (hash-table-p tramp-cache-data)
@@ -464,15 +482,10 @@ used to cache connection properties of the local machine."
;; Dump it.
(with-temp-file tramp-persistency-file-name
(insert
- ";; -*- emacs-lisp -*-"
- ;; `time-stamp-string' might not exist in all Emacs flavors.
- (condition-case nil
- (progn
- (format
- " <%s %s>\n"
- (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
- tramp-persistency-file-name))
- (error "\n"))
+ ;; Starting with Emacs 28, we could use `lisp-data'.
+ (format ";; -*- emacs-lisp -*- <%s %s>\n"
+ (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
+ tramp-persistency-file-name)
";; Tramp connection history. Don't change this file.\n"
";; Run `M-x tramp-cleanup-all-connections' instead.\n\n"
(with-output-to-string
@@ -490,17 +503,14 @@ used to cache connection properties of the local machine."
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from connection history."
- (let (res)
- (maphash
- (lambda (key _value)
- (if (and (tramp-file-name-p key)
- (string-equal method (tramp-file-name-method key))
- (not (tramp-file-name-localname key)))
- (push (list (tramp-file-name-user key)
- (tramp-file-name-host key))
- res)))
- tramp-cache-data)
- res))
+ (mapcar
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (string-equal method (tramp-file-name-method key))
+ (not (tramp-file-name-localname key))
+ (list (tramp-file-name-user key)
+ (tramp-file-name-host key))))
+ (hash-table-keys tramp-cache-data)))
;; When "emacs -Q" has been called, both variables are nil. We do not
;; load the persistency file then, in order to have a clean test environment.
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index b4dca2321c1..827d5f60a2b 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -74,11 +74,13 @@ SYNTAX can be one of the symbols `default' (default),
Each function is called with the current vector as argument.")
;;;###tramp-autoload
-(defun tramp-cleanup-connection (vec &optional keep-debug keep-password)
+(defun tramp-cleanup-connection
+ (vec &optional keep-debug keep-password keep-processes)
"Flush all connection related objects.
This includes password cache, file cache, connection cache,
-buffers. KEEP-DEBUG non-nil preserves the debug buffer.
-KEEP-PASSWORD non-nil preserves the password cache.
+buffers, processes. KEEP-DEBUG non-nil preserves the debug
+buffer. KEEP-PASSWORD non-nil preserves the password cache.
+KEEP-PROCESSES non-nil preserves the asynchronous processes.
When called interactively, a Tramp connection has to be selected."
(interactive
;; When interactive, select the Tramp remote identification.
@@ -107,21 +109,21 @@ When called interactively, a Tramp connection has to be selected."
;; suppressed.
(setq tramp-current-connection nil)
- ;; Flush file cache.
- (tramp-flush-directory-properties vec "")
-
- ;; Flush connection cache.
- (when (processp (tramp-get-connection-process vec))
- (tramp-flush-connection-properties (tramp-get-connection-process vec))
- (delete-process (tramp-get-connection-process vec)))
- (tramp-flush-connection-properties vec)
-
;; Cancel timer.
(dolist (timer timer-list)
(when (and (eq (timer--function timer) 'tramp-timeout-session)
(tramp-file-name-equal-p vec (car (timer--args timer))))
(cancel-timer timer)))
+ ;; Delete processes.
+ (dolist (key (hash-table-keys tramp-cache-data))
+ (when (and (processp key)
+ (tramp-file-name-equal-p (process-get key 'vector) vec)
+ (or (not keep-processes)
+ (eq key (tramp-get-process vec))))
+ (tramp-flush-connection-properties key)
+ (delete-process key)))
+
;; Remove buffers.
(dolist
(buf (list (get-buffer (tramp-buffer-name vec))
@@ -130,6 +132,12 @@ When called interactively, a Tramp connection has to be selected."
(tramp-get-connection-property vec "process-buffer" nil)))
(when (bufferp buf) (kill-buffer buf)))
+ ;; Flush file cache.
+ (tramp-flush-directory-properties vec "")
+
+ ;; Flush connection cache.
+ (tramp-flush-connection-properties vec)
+
;; The end.
(run-hook-with-args 'tramp-cleanup-connection-hook vec)))
@@ -176,8 +184,9 @@ This includes password cache, file cache, connection cache, buffers."
;; Cancel timers.
(cancel-function-timers 'tramp-timeout-session)
- ;; Remove buffers.
+ ;; Remove processes and buffers.
(dolist (name (tramp-list-tramp-buffers))
+ (when (processp (get-buffer-process name)) (delete-process name))
(when (bufferp (get-buffer name)) (kill-buffer name)))
;; The end.
@@ -350,9 +359,8 @@ The remote connection identified by SOURCE is flushed by
(or (setq target (tramp-default-rename-file source))
(tramp-user-error
nil
- (eval-when-compile
- (concat "There is no target specified. "
- "Check `tramp-default-rename-alist' for a proper entry.")))))
+ (concat "There is no target specified. "
+ "Check `tramp-default-rename-alist' for a proper entry."))))
(when (tramp-equal-remote source target)
(tramp-user-error nil "Source and target must have different remote."))
@@ -474,9 +482,7 @@ For details, see `tramp-rename-files'."
(defun tramp-bug ()
"Submit a bug report to the Tramp developers."
(interactive)
- (let ((reporter-prompt-for-summary-p t)
- ;; In rare cases, it could contain the password. So we make it nil.
- tramp-password-save-function)
+ (let ((reporter-prompt-for-summary-p t))
(reporter-submit-bug-report
tramp-bug-report-address ; to-address
(format "tramp (%s %s/%s)" ; package name and version
@@ -484,10 +490,11 @@ For details, see `tramp-rename-files'."
(sort
(delq nil (mapcar
(lambda (x)
- (and x (boundp x) (cons x 'tramp-reporter-dump-variable)))
+ (and x (boundp x) (not (get x 'tramp-suppress-trace))
+ (cons x 'tramp-reporter-dump-variable)))
(append
(mapcar #'intern (all-completions "tramp-" obarray #'boundp))
- ;; Non-tramp variables of interest.
+ ;; Non-Tramp variables of interest.
'(shell-prompt-pattern
backup-by-copying
backup-by-copying-when-linked
@@ -544,11 +551,11 @@ buffer in your bug report.
(string-match-p
(concat "[^" (bound-and-true-p mm-7bit-chars) "]") val))
(with-current-buffer reporter-eval-buffer
- (set
- varsym
- (format
- "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)"
- (base64-encode-string (encode-coding-string val 'raw-text)))))))
+ (set varsym
+ `(decode-coding-string
+ (base64-decode-string
+ ,(base64-encode-string (encode-coding-string val 'raw-text)))
+ 'raw-text)))))
;; Dump variable.
(reporter-dump-variable varsym mailbuf)
@@ -557,11 +564,10 @@ buffer in your bug report.
;; Remove string quotation.
(forward-line -1)
(when (looking-at
- (eval-when-compile
- (concat "\\(^.*\\)" "\"" ;; \1 "
- "\\((base64-decode-string \\)" "\\\\" ;; \2 \
- "\\(\".*\\)" "\\\\" ;; \3 \
- "\\(\")\\)" "\"$"))) ;; \4 "
+ (concat "\\(^.*\\)" "\"" ;; \1 "
+ "\\((base64-decode-string \\)" "\\\\" ;; \2 \
+ "\\(\".*\\)" "\\\\" ;; \3 \
+ "\\(\")\\)" "\"$")) ;; \4 "
(replace-match "\\1\\2\\3\\4")
(beginning-of-line)
(insert " ;; Variable encoded due to non-printable characters.\n"))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index b7a7cc4f003..9a4e16efe20 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -23,15 +23,15 @@
;;; Commentary:
-;; Tramp's main Emacs version for development is Emacs 27. This
-;; package provides compatibility functions for Emacs 24, Emacs 25 and
-;; Emacs 26.
+;; Tramp's main Emacs version for development is Emacs 28. This
+;; package provides compatibility functions for Emacs 25, Emacs 26 and
+;; Emacs 27.
;;; Code:
-;; In Emacs 24 and 25, `tramp-unload-file-name-handlers' is not
-;; autoloaded. So we declare it here in order to avoid recursive
-;; load. This will be overwritten in tramp.el.
+;; In Emacs 25, `tramp-unload-file-name-handlers' is not autoloaded.
+;; So we declare it here in order to avoid recursive load. This will
+;; be overwritten in tramp.el.
(defun tramp-unload-file-name-handlers () ".")
(require 'auth-source)
@@ -43,6 +43,7 @@
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
(declare-function tramp-handle-temporary-file-directory "tramp")
+(defvar tramp-temp-name-prefix)
(defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version)
"The Emacs version used for compilation.")
@@ -60,6 +61,8 @@
`(when (functionp ,function)
(with-no-warnings (funcall ,function ,@arguments))))
+(put #'tramp-compat-funcall 'tramp-suppress-trace t)
+
(defsubst tramp-compat-temporary-file-directory ()
"Return name of directory for temporary files.
It is the default value of `temporary-file-directory'."
@@ -67,15 +70,19 @@ It is the default value of `temporary-file-directory'."
;; into an infloop.
(eval (car (get 'temporary-file-directory 'standard-value))))
+(defsubst tramp-compat-make-temp-name ()
+ "Generate a local temporary file name (compat function)."
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-compat-temporary-file-directory))))
+
(defsubst tramp-compat-make-temp-file (f &optional dir-flag)
"Create a local temporary file (compat function).
Add the extension of F, if existing."
- (let* (file-name-handler-alist
- (prefix (expand-file-name
- (symbol-value 'tramp-temp-name-prefix)
- (tramp-compat-temporary-file-directory)))
- (extension (file-name-extension f t)))
- (make-temp-file prefix dir-flag extension)))
+ (make-temp-file
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-compat-temporary-file-directory))
+ dir-flag (file-name-extension f t)))
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
(defalias 'tramp-compat-temporary-file-directory-function
@@ -83,31 +90,7 @@ Add the extension of F, if existing."
#'temporary-file-directory
#'tramp-handle-temporary-file-directory))
-(defun tramp-compat-process-running-p (process-name)
- "Return t if system process PROCESS-NAME is running for `user-login-name'."
- (when (stringp process-name)
- (cond
- ;; GNU Emacs 22 on w32.
- ((fboundp 'w32-window-exists-p)
- (tramp-compat-funcall 'w32-window-exists-p process-name process-name))
-
- ;; GNU Emacs 23+.
- ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
- (let (result)
- (dolist (pid (tramp-compat-funcall 'list-system-processes) result)
- (let ((attributes (process-attributes pid)))
- (when (and (string-equal
- (cdr (assoc 'user attributes)) (user-login-name))
- (let ((comm (cdr (assoc 'comm attributes))))
- ;; The returned command name could be truncated
- ;; to 15 characters. Therefore, we cannot check
- ;; for `string-equal'.
- (and comm (string-match-p
- (concat "^" (regexp-quote comm))
- process-name))))
- (setq result t)))))))))
-
-;; `file-attribute-*' are introduced in Emacs 25.1.
+;; `file-attribute-*' are introduced in Emacs 26.1.
(defalias 'tramp-compat-file-attribute-type
(if (fboundp 'file-attribute-type)
@@ -189,31 +172,13 @@ and later, and is a float in Emacs 26 and earlier."
This is a string of ten letters or dashes as in ls -l."
(nth 8 attributes))))
-;; `format-message' is new in Emacs 25.1.
-(unless (fboundp 'format-message)
- (defalias 'format-message #'format))
-
-;; `directory-name-p' is new in Emacs 25.1.
-(defalias 'tramp-compat-directory-name-p
- (if (fboundp 'directory-name-p)
- #'directory-name-p
- (lambda (name)
- "Return non-nil if NAME ends with a directory separator character."
- (let ((len (length name))
- (lastc ?.))
- (if (> len 0)
- (setq lastc (aref name (1- len))))
- (or (= lastc ?/)
- (and (memq system-type '(windows-nt ms-dos))
- (= lastc ?\\)))))))
-
;; `file-missing' is introduced in Emacs 26.1.
(defconst tramp-file-missing
(if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
"The error symbol for the `file-missing' error.")
;; `file-local-name', `file-name-quoted-p', `file-name-quote' and
-;; `file-name-unquote' are introduced in Emacs 26.
+;; `file-name-unquote' are introduced in Emacs 26.1.
(defalias 'tramp-compat-file-local-name
(if (fboundp 'file-local-name)
#'file-local-name
@@ -223,7 +188,8 @@ It returns a file name which can be used directly as argument of
`process-file', `start-file-process', or `shell-command'."
(or (file-remote-p name 'localname) name))))
-;; `file-name-quoted-p' got a second argument in Emacs 27.1.
+;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' got
+;; a second argument in Emacs 27.1.
(defalias 'tramp-compat-file-name-quoted-p
(if (and
(fboundp 'file-name-quoted-p)
@@ -265,7 +231,7 @@ NAME is unquoted."
localname (if (= (length localname) 2) "/" (substring localname 2))))
(concat (file-remote-p name) localname)))))
-;; `tramp-syntax' has changed its meaning in Emacs 26. We still
+;; `tramp-syntax' has changed its meaning in Emacs 26.1. We still
;; support old settings.
(defsubst tramp-compat-tramp-syntax ()
"Return proper value of `tramp-syntax'."
@@ -274,13 +240,6 @@ NAME is unquoted."
((eq tramp-syntax 'sep) 'separate)
(t tramp-syntax)))
-;; `cl-struct-slot-info' has been introduced with Emacs 25.
-(defmacro tramp-compat-tramp-file-name-slots ()
- "Return a list of slot names."
- (if (fboundp 'cl-struct-slot-info)
- '(cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name)))
- '(cdr (mapcar #'car (get 'tramp-file-name 'cl-struct-slots)))))
-
;; The signature of `tramp-make-tramp-file-name' has been changed.
;; Therefore, we cannot use `url-tramp-convert-url-to-tramp' prior
;; Emacs 26.1. We use `temporary-file-directory' as indicator.
@@ -293,10 +252,9 @@ NAME is unquoted."
#'exec-path
(lambda ()
"List of directories to search programs to run in remote subprocesses."
- (let ((handler (find-file-name-handler default-directory 'exec-path)))
- (if handler
- (funcall handler 'exec-path)
- exec-path)))))
+ (if-let ((handler (find-file-name-handler default-directory 'exec-path)))
+ (funcall handler 'exec-path)
+ exec-path))))
;; `time-equal-p' has appeared in Emacs 27.1.
(defalias 'tramp-compat-time-equal-p
@@ -331,16 +289,65 @@ A nil value for either argument stands for the current time."
(lambda (reporter &optional value _suffix)
(progress-reporter-update reporter value))))
+;; `file-modes', `set-file-modes' and `set-file-times' got argument
+;; FLAG in Emacs 28.1.
+(defalias 'tramp-compat-file-modes
+ (if (equal (tramp-compat-funcall 'func-arity #'file-modes) '(1 . 2))
+ #'file-modes
+ (lambda (filename &optional _flag)
+ (file-modes filename))))
+
+(defalias 'tramp-compat-set-file-modes
+ (if (equal (tramp-compat-funcall 'func-arity #'set-file-modes) '(2 . 3))
+ #'set-file-modes
+ (lambda (filename mode &optional _flag)
+ (set-file-modes filename mode))))
+
+(defalias 'tramp-compat-set-file-times
+ (if (equal (tramp-compat-funcall 'func-arity #'set-file-times) '(1 . 3))
+ #'set-file-times
+ (lambda (filename &optional timestamp _flag)
+ (set-file-times filename timestamp))))
+
+;; `directory-files' and `directory-files-and-attributes' got argument
+;; COUNT in Emacs 28.1.
+(defalias 'tramp-compat-directory-files
+ (if (equal (tramp-compat-funcall 'func-arity #'directory-files) '(1 . 5))
+ #'directory-files
+ (lambda (directory &optional full match nosort _count)
+ (directory-files directory full match nosort))))
+
+(defalias 'tramp-compat-directory-files-and-attributes
+ (if (equal (tramp-compat-funcall 'func-arity #'directory-files-and-attributes)
+ '(1 . 6))
+ #'directory-files-and-attributes
+ (lambda (directory &optional full match nosort id-format _count)
+ (directory-files-and-attributes directory full match nosort id-format))))
+
+;; `directory-empty-p' is new in Emacs 28.1.
+(defalias 'tramp-compat-directory-empty-p
+ (if (fboundp 'directory-empty-p)
+ #'directory-empty-p
+ (lambda (dir)
+ (and (file-directory-p dir)
+ (null (tramp-compat-directory-files
+ dir nil directory-files-no-dot-files-regexp t 1))))))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-loaddefs 'force)
(unload-feature 'tramp-compat 'force)))
+(provide 'tramp-compat)
+
;;; TODO:
;;
-;; * Starting with Emacs 25.1, replace `tramp-message-show-message' by
-;; the reverse of `inhibit-message'.
-
-(provide 'tramp-compat)
+;; * `func-arity' exists since Emacs 26.1.
+;;
+;; * Starting with Emacs 27.1, there's no need to escape open
+;; parentheses with a backslash in docstrings anymore.
+;;
+;; * Starting with Emacs 27.1, there's `make-empty-file'. Could be
+;; used instead of `write-region'.
;;; tramp-compat.el ends here
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
new file mode 100644
index 00000000000..4d34bbbeea6
--- /dev/null
+++ b/lisp/net/tramp-crypt.el
@@ -0,0 +1,844 @@
+;;; tramp-crypt.el --- Tramp crypt utilities -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Access functions for crypted remote files. It uses encfs to
+;; encrypt / decrypt the files on a remote directory. A remote
+;; directory, which shall include crypted files, must be declared in
+;; `tramp-crypt-directories' via command `tramp-crypt-add-directory'.
+;; All files in that directory, including all subdirectories, are
+;; stored there encrypted. This includes file names and directory
+;; names.
+
+;; This package is just responsible for the encryption part. Copying
+;; of the crypted files is still the responsibility of the remote file
+;; name handlers.
+
+;; A password protected encfs configuration file is created the very
+;; first time you access a crypted remote directory. It is kept in
+;; your user directory "~/.emacs.d/" with the url-encoded directory
+;; name as part of the basename, and ".encfs6.xml" as suffix. Do not
+;; loose this file and the corresponding password; otherwise there is
+;; no way to decrypt your crypted files.
+
+;; If the user option `tramp-crypt-save-encfs-config-remote' is
+;; non-nil (the default), the encfs configuration file ".encfs6.xml"
+;; is also kept in the crypted remote directory. It depends on you,
+;; whether you regard the password protection of this file as
+;; sufficient.
+
+;; If you use a remote file name with a quoted localname part, this
+;; localname and the corresponding file will not be encrypted/
+;; decrypted. For example, if you have a crypted remote directory
+;; "/nextcloud:user@host:/crypted_dir", the command
+;;
+;; C-x d /nextcloud:user@host:/crypted_dir
+;;
+;; will show the directory listing with the plain file names, and the
+;; command
+;;
+;; C-x d /nextcloud:user@host:/:/crypted_dir
+;;
+;; will show the directory with the encrypted file names, and visiting
+;; a file will show its crypted contents. However, it is highly
+;; discouraged to mix crypted and not crypted files in the same
+;; directory.
+
+;; If a remote directory shall not include crypted files anymore, it
+;; must be indicated by the command `tramp-crypt-remove-directory'.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'tramp)
+
+(autoload 'prop-match-beginning "text-property-search")
+(autoload 'prop-match-end "text-property-search")
+(autoload 'text-property-search-forward "text-property-search")
+
+(defconst tramp-crypt-method "crypt"
+ "Method name for crypted remote directories.")
+
+(defcustom tramp-crypt-encfs-program "encfs"
+ "Name of the encfs program."
+ :group 'tramp
+ :version "28.1"
+ :type 'string)
+
+(defcustom tramp-crypt-encfsctl-program "encfsctl"
+ "Name of the encfsctl program."
+ :group 'tramp
+ :version "28.1"
+ :type 'string)
+
+(defcustom tramp-crypt-encfs-option "--standard"
+ "Configuration option for encfs.
+This could be either \"--standard\" or \"--paranoia\". The file
+name IV chaining mode mode will always be disabled when
+initializing a new crypted remote directory."
+ :group 'tramp
+ :version "28.1"
+ :type '(choice (const "--standard")
+ (const "--paranoia")))
+
+;; We check only for encfs, assuming that encfsctl will be available
+;; as well. The autoloaded value is nil, the check will run when
+;; tramp-crypt.el is loaded by `tramp-crypt-add-directory'. It is a
+;; common technique to let-bind this variable to nil in order to
+;; suppress the file name operation of this package.
+;;;###tramp-autoload
+(defvar tramp-crypt-enabled nil
+ "Non-nil when encryption support is available.")
+(setq tramp-crypt-enabled (executable-find tramp-crypt-encfs-program))
+
+;;;###tramp-autoload
+(defconst tramp-crypt-encfs-config ".encfs6.xml"
+ "Encfs configuration file name.")
+
+(defcustom tramp-crypt-save-encfs-config-remote t
+ "Whether to keep the encfs configuration file in the crypted remote directory."
+ :group 'tramp
+ :version "28.1"
+ :type 'boolean)
+
+;;;###tramp-autoload
+(defvar tramp-crypt-directories nil
+ "List of crypted remote directories.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-crypt-file-name-p (name)
+ "Return the crypted remote directory NAME belongs to.
+If NAME doesn't belong to a crypted remote directory, retun nil."
+ (catch 'crypt-file-name-p
+ (and tramp-crypt-enabled (stringp name)
+ (not (tramp-compat-file-name-quoted-p name))
+ (not (string-suffix-p tramp-crypt-encfs-config name))
+ (dolist (dir tramp-crypt-directories)
+ (and (string-prefix-p
+ dir (file-name-as-directory (expand-file-name name)))
+ (throw 'crypt-file-name-p dir))))))
+
+
+;; New handlers should be added here.
+;;;###tramp-autoload
+(defconst tramp-crypt-file-name-handler-alist
+ '((access-file . tramp-crypt-handle-access-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ (copy-directory . tramp-handle-copy-directory)
+ (copy-file . tramp-crypt-handle-copy-file)
+ (delete-directory . tramp-crypt-handle-delete-directory)
+ (delete-file . tramp-crypt-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ ;; `directory-file-name' performed by default handler.
+ (directory-files . tramp-crypt-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-handle-directory-files-and-attributes)
+ (dired-compress-file . ignore)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . ignore)
+ ;; `expand-file-name' performed by default handler.
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
+ (file-attributes . tramp-crypt-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-crypt-handle-file-executable-p)
+ (file-exists-p . tramp-handle-file-exists-p)
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
+ (file-local-copy . tramp-handle-file-local-copy)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions . tramp-crypt-handle-file-name-all-completions)
+ ;; `file-name-as-directory' performed by default handler.
+ (file-name-case-insensitive-p . ignore)
+ (file-name-completion . tramp-handle-file-name-completion)
+ ;; `file-name-directory' performed by default handler.
+ ;; `file-name-nondirectory' performed by default handler.
+ ;; `file-name-sans-versions' performed by default handler.
+ (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . ignore)
+ (file-notify-rm-watch . ignore)
+ (file-notify-valid-p . ignore)
+ (file-ownership-preserved-p . tramp-crypt-handle-file-ownership-preserved-p)
+ (file-readable-p . tramp-crypt-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ ;; `file-remote-p' performed by default handler.
+ (file-selinux-context . ignore)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-crypt-handle-file-system-info)
+ ;; `file-truename' performed by default handler.
+ (file-writable-p . tramp-crypt-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-crypt-handle-insert-directory)
+ ;; `insert-file-contents' performed by default handler.
+ (load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-crypt-handle-make-directory)
+ (make-directory-internal . ignore)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . ignore)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-file . ignore)
+ (rename-file . tramp-crypt-handle-rename-file)
+ (set-file-acl . ignore)
+ (set-file-modes . tramp-crypt-handle-set-file-modes)
+ (set-file-selinux-context . ignore)
+ (set-file-times . tramp-crypt-handle-set-file-times)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . ignore)
+ (start-file-process . ignore)
+ ;; `substitute-in-file-name' performed by default handler.
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ ;; `tramp-get-remote-gid' performed by default handler.
+ ;; `tramp-get-remote-uid' performed by default handler.
+ (tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid)
+ (unhandled-file-name-directory . ignore)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-handle-write-region))
+ "Alist of handler functions for crypt method.
+Operations not mentioned here will be handled by the default Emacs primitives.")
+
+(defsubst tramp-crypt-file-name-for-operation (operation &rest args)
+ "Like `tramp-file-name-for-operation', but for crypted remote files."
+ (let ((tfnfo (apply #'tramp-file-name-for-operation operation args)))
+ ;; `tramp-file-name-for-operation' returns already the first argument
+ ;; if it is remote. So we check a possible second argument.
+ (unless (tramp-crypt-file-name-p tfnfo)
+ (setq tfnfo (apply
+ #'tramp-file-name-for-operation operation
+ (cons (tramp-compat-temporary-file-directory) (cdr args)))))
+ tfnfo))
+
+(defun tramp-crypt-run-real-handler (operation args)
+ "Invoke normal file name handler for OPERATION.
+First arg specifies the OPERATION, second arg ARGS is a list of
+arguments to pass to the OPERATION."
+ (let* ((inhibit-file-name-handlers
+ `(tramp-crypt-file-name-handler
+ .
+ ,(and (eq inhibit-file-name-operation operation)
+ inhibit-file-name-handlers)))
+ (inhibit-file-name-operation operation))
+ (apply operation args)))
+
+;;;###tramp-autoload
+(defun tramp-crypt-file-name-handler (operation &rest args)
+ "Invoke the crypted remote file related OPERATION.
+First arg specifies the OPERATION, second arg ARGS is a list of
+arguments to pass to the OPERATION."
+ (if-let ((filename
+ (apply #'tramp-crypt-file-name-for-operation operation args))
+ (fn (and (tramp-crypt-file-name-p filename)
+ (assoc operation tramp-crypt-file-name-handler-alist))))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-crypt-run-real-handler operation args)))
+
+;;;###tramp-autoload
+(progn (defun tramp-register-crypt-file-name-handler ()
+ "Add crypt file name handler to `file-name-handler-alist'."
+ (when (and tramp-crypt-enabled tramp-crypt-directories)
+ (add-to-list 'file-name-handler-alist
+ (cons tramp-file-name-regexp #'tramp-crypt-file-name-handler))
+ (put #'tramp-crypt-file-name-handler 'safe-magic t))))
+
+(tramp-register-file-name-handlers)
+
+;; Mark `operations' the handler is responsible for.
+(put #'tramp-crypt-file-name-handler 'operations
+ (mapcar #'car tramp-crypt-file-name-handler-alist))
+
+
+;; File name conversions.
+
+(defun tramp-crypt-config-file-name (vec)
+ "Return the encfs config file name for VEC."
+ (expand-file-name
+ (concat "tramp-" (tramp-file-name-host vec) tramp-crypt-encfs-config)
+ user-emacs-directory))
+
+(defun tramp-crypt-maybe-open-connection (vec)
+ "Maybe open a connection VEC.
+Does not do anything if a connection is already open, but re-opens the
+connection if a previous connection has died for some reason."
+ ;; For password handling, we need a process bound to the connection
+ ;; buffer. Therefore, we create a dummy process. Maybe there is a
+ ;; better solution?
+ (unless (get-buffer-process (tramp-get-connection-buffer vec))
+ (let ((p (make-network-process
+ :name (tramp-get-connection-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (process-put p 'vector vec)
+ (set-process-query-on-exit-flag p nil)))
+
+ ;; The following operations must be performed w/o
+ ;; `tramp-crypt-file-name-handler'.
+ (let* (tramp-crypt-enabled
+ ;; Don't check for a proper method.
+ (non-essential t)
+ (remote-config
+ (expand-file-name
+ tramp-crypt-encfs-config (tramp-crypt-get-remote-dir vec)))
+ (local-config (tramp-crypt-config-file-name vec)))
+ ;; There is no local encfs6 config file.
+ (when (not (file-exists-p local-config))
+ (if (and tramp-crypt-save-encfs-config-remote
+ (file-exists-p remote-config))
+ ;; Copy remote encfs6 config file if possible.
+ (copy-file remote-config local-config 'ok 'keep)
+
+ ;; Create local encfs6 config file otherwise.
+ (let* ((default-directory (tramp-compat-temporary-file-directory))
+ (tmpdir1 (file-name-as-directory
+ (tramp-compat-make-temp-file " .crypt" 'dir-flag)))
+ (tmpdir2 (file-name-as-directory
+ (tramp-compat-make-temp-file " .nocrypt" 'dir-flag))))
+ ;; Enable `auth-source', unless "emacs -Q" has been called.
+ (tramp-set-connection-property
+ vec "first-password-request" tramp-cache-read-persistent-data)
+ (with-temp-buffer
+ (insert
+ (tramp-read-passwd
+ (tramp-get-connection-process vec)
+ (format
+ "New EncFS Password for %s " (tramp-crypt-get-remote-dir vec))))
+ (when
+ (zerop
+ (tramp-call-process-region
+ vec (point-min) (point-max)
+ tramp-crypt-encfs-program nil (tramp-get-connection-buffer vec)
+ nil tramp-crypt-encfs-option "--extpass=cat" tmpdir1 tmpdir2))
+ ;; Save the password.
+ (ignore-errors
+ (and (functionp tramp-password-save-function)
+ (funcall tramp-password-save-function)))))
+
+ ;; Write local config file. Suppress file name IV chaining mode.
+ (with-temp-file local-config
+ (insert-file-contents
+ (expand-file-name tramp-crypt-encfs-config tmpdir1))
+ (when (search-forward
+ "<chainedNameIV>1</chainedNameIV>" nil 'noerror)
+ (replace-match "<chainedNameIV>0</chainedNameIV>")))
+
+ ;; Unmount encfs. Delete temporary directories.
+ (tramp-call-process
+ vec tramp-crypt-encfs-program nil nil nil
+ "--unmount" tmpdir1 tmpdir2)
+ (delete-directory tmpdir1 'recursive)
+ (delete-directory tmpdir2)
+
+ ;; Copy local encfs6 config file to remote.
+ (when tramp-crypt-save-encfs-config-remote
+ (copy-file local-config remote-config 'ok 'keep)))))))
+
+(defun tramp-crypt-send-command (vec &rest args)
+ "Send encfsctl command to connection VEC.
+ARGS are the arguments. It returns t if ran successful, and nil otherwise."
+ (tramp-crypt-maybe-open-connection vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (erase-buffer)
+ (set-buffer-multibyte nil))
+ (with-temp-buffer
+ (let* (;; Don't check for a proper method.
+ (non-essential t)
+ (default-directory (tramp-compat-temporary-file-directory))
+ ;; We cannot add it to `process-environment', because
+ ;; `tramp-call-process-region' doesn't use it.
+ (encfs-config
+ (format "ENCFS6_CONFIG=%s" (tramp-crypt-config-file-name vec)))
+ (args (delq nil args)))
+ ;; Enable `auth-source', unless "emacs -Q" has been called.
+ (tramp-set-connection-property
+ vec "first-password-request" tramp-cache-read-persistent-data)
+ (insert
+ (tramp-read-passwd
+ (tramp-get-connection-process vec)
+ (format "EncFS Password for %s " (tramp-crypt-get-remote-dir vec))))
+ (when (zerop
+ (apply
+ #'tramp-call-process-region vec (point-min) (point-max)
+ "env" nil (tramp-get-connection-buffer vec)
+ nil encfs-config tramp-crypt-encfsctl-program
+ (car args) "--extpass=cat" (cdr args)))
+ ;; Save the password.
+ (ignore-errors
+ (and (functionp tramp-password-save-function)
+ (funcall tramp-password-save-function)))
+ t))))
+
+(defun tramp-crypt-do-encrypt-or-decrypt-file-name (op name)
+ "Return encrypted / decrypted NAME if NAME belongs to a crypted directory.
+OP must be `encrypt' or `decrypt'. Raise an error if this fails.
+Otherwise, return NAME."
+ (if-let ((tramp-crypt-enabled t)
+ (dir (tramp-crypt-file-name-p name))
+ ;; It must be absolute for the cache.
+ (localname (substring name (1- (length dir))))
+ (crypt-vec (tramp-crypt-dissect-file-name dir)))
+ ;; Preserve trailing "/".
+ (funcall
+ (if (directory-name-p name) #'file-name-as-directory #'identity)
+ (concat
+ dir
+ (unless (string-equal localname "/")
+ (with-tramp-file-property
+ crypt-vec localname (concat (symbol-name op) "-file-name")
+ (unless (tramp-crypt-send-command
+ crypt-vec (if (eq op 'encrypt) "encode" "decode")
+ (tramp-compat-temporary-file-directory) localname)
+ (tramp-error
+ crypt-vec 'file-error "%s of file name %s failed."
+ (if (eq op 'encrypt) "Encoding" "Decoding") name))
+ (with-current-buffer (tramp-get-connection-buffer crypt-vec)
+ (goto-char (point-min))
+ (buffer-substring (point-min) (point-at-eol)))))))
+ ;; Nothing to do.
+ name))
+
+(defsubst tramp-crypt-encrypt-file-name (name)
+ "Return encrypted NAME if NAME belongs to a crypted directory.
+Otherwise, return NAME."
+ (tramp-crypt-do-encrypt-or-decrypt-file-name 'encrypt name))
+
+(defsubst tramp-crypt-decrypt-file-name (name)
+ "Return decrypted NAME if NAME belongs to a crypted directory.
+Otherwise, return NAME."
+ (tramp-crypt-do-encrypt-or-decrypt-file-name 'decrypt name))
+
+(defun tramp-crypt-do-encrypt-or-decrypt-file (op root infile outfile)
+ "Encrypt / decrypt file INFILE to OUTFILE according to crypted directory ROOT.
+Both files must be local files. OP must be `encrypt' or `decrypt'.
+If OP ist `decrypt', the basename of INFILE must be an encrypted file name.
+Raise an error if this fails."
+ (when-let ((tramp-crypt-enabled t)
+ (dir (tramp-crypt-file-name-p root))
+ (crypt-vec (tramp-crypt-dissect-file-name dir)))
+ (let ((coding-system-for-read
+ (if (eq op 'decrypt) 'binary coding-system-for-read))
+ (coding-system-for-write
+ (if (eq op 'encrypt) 'binary coding-system-for-write)))
+ (unless (tramp-crypt-send-command
+ crypt-vec "cat" (and (eq op 'encrypt) "--reverse")
+ (file-name-directory infile)
+ (concat "/" (file-name-nondirectory infile)))
+ (tramp-error
+ crypt-vec 'file-error "%s of file %s failed."
+ (if (eq op 'encrypt) "Encrypting" "Decrypting") infile))
+ (with-current-buffer (tramp-get-connection-buffer crypt-vec)
+ (write-region nil nil outfile)))))
+
+(defsubst tramp-crypt-encrypt-file (root infile outfile)
+ "Encrypt file INFILE to OUTFILE according to crypted directory ROOT.
+See `tramp-crypt-do-encrypt-or-decrypt-file'."
+ (tramp-crypt-do-encrypt-or-decrypt-file 'encrypt root infile outfile))
+
+(defsubst tramp-crypt-decrypt-file (root infile outfile)
+ "Decrypt file INFILE to OUTFILE according to crypted directory ROOT.
+See `tramp-crypt-do-encrypt-or-decrypt-file'."
+ (tramp-crypt-do-encrypt-or-decrypt-file 'decrypt root infile outfile))
+
+;;;###tramp-autoload
+(defun tramp-crypt-add-directory (name)
+ "Mark remote directory NAME for encryption.
+Files in that directory and all subdirectories will be encrypted
+before copying to, and decrypted after copying from that
+directory. File names will be also encrypted."
+ (interactive "DRemote directory name: ")
+ (unless tramp-crypt-enabled
+ (tramp-user-error nil "Feature is not enabled."))
+ (unless (and (tramp-tramp-file-p name) (file-directory-p name))
+ (tramp-user-error nil "%s must be an existing remote directory." name))
+ (when (tramp-compat-file-name-quoted-p name)
+ (tramp-user-error nil "%s must not be quoted." name))
+ (setq name (file-name-as-directory (expand-file-name name)))
+ (unless (member name tramp-crypt-directories)
+ (setq tramp-crypt-directories (cons name tramp-crypt-directories)))
+ (tramp-register-file-name-handlers))
+
+(defun tramp-crypt-remove-directory (name)
+ "Unmark remote directory NAME for encryption.
+Existing files in that directory and its subdirectories will be
+kept in their encrypted form."
+ (interactive "DRemote directory name: ")
+ (unless tramp-crypt-enabled
+ (tramp-user-error nil "Feature is not enabled."))
+ (setq name (file-name-as-directory (expand-file-name name)))
+ (when (and (member name tramp-crypt-directories)
+ (delete
+ tramp-crypt-encfs-config
+ (directory-files name nil directory-files-no-dot-files-regexp))
+ (yes-or-no-p
+ "There exist encrypted files, do you want to continue? "))
+ (setq tramp-crypt-directories (delete name tramp-crypt-directories))
+ (tramp-register-file-name-handlers)))
+
+;; `auth-source' requires a user.
+(defun tramp-crypt-dissect-file-name (name)
+ "Return a `tramp-file-name' structure for NAME.
+The structure consists of the `tramp-crypt-method' method, the
+local user name, the hexlified directory NAME as host, and the
+localname."
+ (save-match-data
+ (if-let ((dir (tramp-crypt-file-name-p name)))
+ (make-tramp-file-name
+ :method tramp-crypt-method :user (user-login-name)
+ :host (url-hexify-string dir))
+ (tramp-user-error nil "Not a crypted remote directory: \"%s\"" name))))
+
+(defun tramp-crypt-get-remote-dir (vec)
+ "Return the name of the crypted remote directory to be used for encfs."
+ (url-unhex-string (tramp-file-name-host vec)))
+
+
+;; File name primitives.
+
+(defun tramp-crypt-handle-access-file (filename string)
+ "Like `access-file' for Tramp files."
+ (let* ((encrypt-filename (tramp-crypt-encrypt-file-name filename))
+ (encrypt-regexp (concat (regexp-quote encrypt-filename) "\\'"))
+ tramp-crypt-enabled)
+ (condition-case err
+ (access-file encrypt-filename string)
+ (error
+ (when (and (eq (car err) 'file-missing) (stringp (cadr err))
+ (string-match-p encrypt-regexp (cadr err)))
+ (setcar
+ (cdr err)
+ (replace-regexp-in-string encrypt-regexp filename (cadr err))))
+ (signal (car err) (cdr err))))))
+
+(defun tramp-crypt-do-copy-or-rename-file
+ (op filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Copy or rename a remote file.
+OP must be `copy' or `rename' and indicates the operation to perform.
+FILENAME specifies the file to copy or rename, NEWNAME is the name of
+the new file (for copy) or the new name of the file (for rename).
+OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
+KEEP-DATE means to make sure that NEWNAME has the same timestamp
+as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
+the uid and gid if both files are on the same host.
+PRESERVE-EXTENDED-ATTRIBUTES is ignored.
+
+This function is invoked by `tramp-crypt-handle-copy-file' and
+`tramp-crypt-handle-rename-file'. It is an error if OP is
+neither of `copy' and `rename'. FILENAME and NEWNAME must be
+absolute file names."
+ (unless (memq op '(copy rename))
+ (error "Unknown operation `%s', must be `copy' or `rename'" op))
+
+ (setq filename (file-truename filename))
+ (let ((t1 (tramp-crypt-file-name-p filename))
+ (t2 (tramp-crypt-file-name-p newname))
+ (encrypt-filename (tramp-crypt-encrypt-file-name filename))
+ (encrypt-newname (tramp-crypt-encrypt-file-name newname))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
+
+ (if (file-directory-p filename)
+ (progn
+ (copy-directory filename newname keep-date t)
+ (when (eq op 'rename)
+ (delete-directory filename 'recursive)))
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (unless (file-exists-p filename)
+ (tramp-error
+ v tramp-file-missing
+ "%s file" msg-operation "No such file or directory" filename))
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (if (and t1 t2 (string-equal t1 t2))
+ ;; Both files are on the same crypted remote directory.
+ (let (tramp-crypt-enabled)
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename encrypt-newname ok-if-already-exists
+ keep-date preserve-uid-gid preserve-extended-attributes)
+ (rename-file
+ encrypt-filename encrypt-newname ok-if-already-exists)))
+
+ (let* ((tmpdir (tramp-compat-make-temp-file filename 'dir))
+ (tmpfile1
+ (expand-file-name
+ (file-name-nondirectory encrypt-filename) tmpdir))
+ (tmpfile2
+ (expand-file-name
+ (file-name-nondirectory encrypt-newname) tmpdir))
+ tramp-crypt-enabled)
+ (cond
+ ;; Source and target file are on a crypted remote directory.
+ ((and t1 t2)
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename encrypt-newname ok-if-already-exists
+ keep-date preserve-uid-gid preserve-extended-attributes)
+ (rename-file
+ encrypt-filename encrypt-newname ok-if-already-exists)))
+ ;; Source file is on a crypted remote directory.
+ (t1
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename tmpfile1 t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file encrypt-filename tmpfile1 t))
+ (tramp-crypt-decrypt-file t1 tmpfile1 tmpfile2)
+ (rename-file tmpfile2 newname ok-if-already-exists))
+ ;; Target file is on a crypted remote directory.
+ (t2
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile1 t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile1 t))
+ (tramp-crypt-encrypt-file t2 tmpfile1 tmpfile2)
+ (rename-file tmpfile2 encrypt-newname ok-if-already-exists)))
+ (delete-directory tmpdir 'recursive))))))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties v2 v2-localname)))))
+
+(defun tramp-crypt-handle-copy-file
+ (filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Like `copy-file' for Tramp files."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-crypt-do-copy-or-rename-file
+ 'copy filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (tramp-run-real-handler
+ #'copy-file
+ (list filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+;; Crypted files won't be trashed.
+(defun tramp-crypt-handle-delete-directory
+ (directory &optional recursive _trash)
+ "Like `delete-directory' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (tramp-flush-directory-properties v localname)
+ (let (tramp-crypt-enabled)
+ (delete-directory (tramp-crypt-encrypt-file-name directory) recursive))))
+
+;; Crypted files won't be trashed.
+(defun tramp-crypt-handle-delete-file (filename &optional _trash)
+ "Like `delete-file' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (delete-file (tramp-crypt-encrypt-file-name filename)))))
+
+(defun tramp-crypt-handle-directory-files
+ (directory &optional full match nosort count)
+ "Like `directory-files' for Tramp files."
+ (unless (file-exists-p directory)
+ (tramp-error
+ (tramp-dissect-file-name directory) tramp-file-missing
+ "No such file or directory" directory))
+ (when (file-directory-p directory)
+ (setq directory (file-name-as-directory (expand-file-name directory)))
+ (let* (tramp-crypt-enabled
+ (result
+ (directory-files (tramp-crypt-encrypt-file-name directory) 'full)))
+ (setq result
+ (mapcar (lambda (x) (tramp-crypt-decrypt-file-name x)) result))
+ (when match
+ (setq result
+ (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (when (string-match-p match (substring x (length directory)))
+ x))
+ result))))
+ (unless full
+ (setq result
+ (mapcar
+ (lambda (x)
+ (replace-regexp-in-string
+ (concat "^" (regexp-quote directory)) "" x))
+ result)))
+ (unless nosort
+ (setq result (sort result #'string<)))
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+ result)))
+
+(defun tramp-crypt-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-attributes (tramp-crypt-encrypt-file-name filename) id-format)))
+
+(defun tramp-crypt-handle-file-executable-p (filename)
+ "Like `file-executable-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-executable-p (tramp-crypt-encrypt-file-name filename))))
+
+(defun tramp-crypt-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (all-completions
+ filename
+ (let* (completion-regexp-list
+ tramp-crypt-enabled
+ (directory (file-name-as-directory directory))
+ (enc-dir (tramp-crypt-encrypt-file-name directory)))
+ (mapcar
+ (lambda (x)
+ (substring
+ (tramp-crypt-decrypt-file-name (concat enc-dir x))
+ (length directory)))
+ (file-name-all-completions "" enc-dir)))))
+
+(defun tramp-crypt-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-readable-p (tramp-crypt-encrypt-file-name filename))))
+
+(defun tramp-crypt-handle-file-ownership-preserved-p (filename &optional group)
+ "Like `file-ownership-preserved-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-ownership-preserved-p (tramp-crypt-encrypt-file-name filename) group)))
+
+(defun tramp-crypt-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (let (tramp-crypt-enabled)
+ ;; `file-system-info' exists since Emacs 27.1.
+ (tramp-compat-funcall
+ 'file-system-info (tramp-crypt-encrypt-file-name filename))))
+
+(defun tramp-crypt-handle-file-writable-p (filename)
+ "Like `file-writable-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-writable-p (tramp-crypt-encrypt-file-name filename))))
+
+(defun tramp-crypt-handle-insert-directory
+ (filename switches &optional wildcard full-directory-p)
+ "Like `insert-directory' for Tramp files.
+WILDCARD is not supported."
+ ;; This package has been added to Emacs 27.1.
+ (when (load "text-property-search" 'noerror 'nomessage)
+ (let (tramp-crypt-enabled)
+ (tramp-handle-insert-directory
+ (tramp-crypt-encrypt-file-name filename)
+ switches wildcard full-directory-p)
+ (let* ((filename (file-name-as-directory filename))
+ (enc (tramp-crypt-encrypt-file-name filename))
+ match string)
+ (goto-char (point-min))
+ (while (setq match (text-property-search-forward 'dired-filename t t))
+ (setq string
+ (buffer-substring
+ (prop-match-beginning match) (prop-match-end match))
+ string (if (file-name-absolute-p string)
+ (tramp-crypt-decrypt-file-name string)
+ (substring
+ (tramp-crypt-decrypt-file-name (concat enc string))
+ (length filename))))
+ (delete-region (prop-match-beginning match) (prop-match-end match))
+ (insert (propertize string 'dired-filename t)))))))
+
+(defun tramp-crypt-handle-make-directory (dir &optional parents)
+ "Like `make-directory' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name dir) nil
+ (when (and (null parents) (file-exists-p dir))
+ (tramp-error v 'file-already-exists "Directory already exists %s" dir))
+ (let (tramp-crypt-enabled)
+ (make-directory (tramp-crypt-encrypt-file-name dir) parents))
+ ;; When PARENTS is non-nil, DIR could be a chain of non-existent
+ ;; directories a/b/c/... Instead of checking, we simply flush the
+ ;; whole cache.
+ (tramp-flush-directory-properties
+ v (if parents "/" (file-name-directory localname)))))
+
+(defun tramp-crypt-handle-rename-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `rename-file' for Tramp files."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-crypt-do-copy-or-rename-file
+ 'rename filename newname ok-if-already-exists
+ 'keep-date 'preserve-uid-gid)
+ (tramp-run-real-handler
+ #'rename-file (list filename newname ok-if-already-exists))))
+
+(defun tramp-crypt-handle-set-file-modes (filename mode &optional flag)
+ "Like `set-file-modes' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (tramp-compat-set-file-modes
+ (tramp-crypt-encrypt-file-name filename) mode flag))))
+
+(defun tramp-crypt-handle-set-file-times (filename &optional time flag)
+ "Like `set-file-times' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (tramp-compat-set-file-times
+ (tramp-crypt-encrypt-file-name filename) time flag))))
+
+(defun tramp-crypt-handle-set-file-uid-gid (filename &optional uid gid)
+ "Like `tramp-set-file-uid-gid' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)
+ (let (tramp-crypt-enabled)
+ (tramp-set-file-uid-gid
+ (tramp-crypt-encrypt-file-name filename) uid gid))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-crypt 'force)))
+
+(provide 'tramp-crypt)
+
+;;; TODO:
+
+;; * I suggest having a feature where the user can specify to always
+;; use encryption for certain host names. So if you specify a host
+;; name which is on that list (of names, or perhaps regexps?), tramp
+;; would modify the request so as to do the encryption. (Richard Stallman)
+
+;;; tramp-crypt.el ends here
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 95ae1569dc9..996a92454f1 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -31,8 +31,7 @@
(require 'tramp)
;; Pacify byte-compiler.
-(eval-when-compile
- (require 'custom))
+(eval-when-compile (require 'custom))
(defvar ange-ftp-ftp-name-arg)
(defvar ange-ftp-ftp-name-res)
(defvar ange-ftp-name-format)
@@ -79,9 +78,9 @@ present for backward compatibility."
;;; This regexp recognizes absolute filenames with only one component
;;; on Windows, for the sake of hostname completion.
(and (memq system-type '(ms-dos windows-nt))
- (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist)
+ (or (assoc "^[[:alpha:]]:/[^/:]*\\'" file-name-handler-alist)
(setq file-name-handler-alist
- (cons '("^[a-zA-Z]:/[^/:]*\\'" .
+ (cons '("^[:alpha:]]:/[^/:]*\\'" .
ange-ftp-completion-hook-function)
file-name-handler-alist)))))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index e369061664a..098fba56b5b 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -49,11 +49,15 @@
;; The user option `tramp-gvfs-methods' contains the list of supported
;; connection methods. Per default, these are "afp", "dav", "davs",
-;; "gdrive", "nextcloud" and "sftp".
+;; "gdrive", "media", "nextcloud" and "sftp".
;; "gdrive" and "nextcloud" connection methods require a respective
;; account in GNOME Online Accounts, with enabled "Files" service.
+;; The "media" connection method is responsible for media devices,
+;; like cell phones, tablets, cameras etc. The device must already be
+;; connected via USB, before accessing it.
+
;; Other possible connection methods are "ftp", "http", "https" and
;; "smb". When one of these methods is added to the list, the remote
;; access for that method is performed via GVFS instead of the native
@@ -104,8 +108,7 @@
(require 'url-util)
;; Pacify byte-compiler.
-(eval-when-compile
- (require 'custom))
+(eval-when-compile (require 'custom))
(declare-function zeroconf-init "zeroconf")
(declare-function zeroconf-list-service-types "zeroconf")
@@ -124,16 +127,16 @@
(or ;; Until Emacs 25, `process-attributes' could crash Emacs
;; for some processes. Better we don't check.
(<= emacs-major-version 25)
- (tramp-compat-process-running-p "gvfs-fuse-daemon")
- (tramp-compat-process-running-p "gvfsd-fuse"))))
+ (tramp-process-running-p "gvfs-fuse-daemon")
+ (tramp-process-running-p "gvfsd-fuse"))))
"Non-nil when GVFS is available.")
;;;###tramp-autoload
(defcustom tramp-gvfs-methods
- '("afp" "dav" "davs" "gdrive" "nextcloud" "sftp")
+ '("afp" "dav" "davs" "gdrive" "media" "nextcloud" "sftp")
"List of methods for remote files, accessed with GVFS."
:group 'tramp
- :version "27.1"
+ :version "28.1"
:type '(repeat (choice (const "afp")
(const "dav")
(const "davs")
@@ -141,10 +144,12 @@
(const "gdrive")
(const "http")
(const "https")
+ (const "media")
(const "nextcloud")
(const "sftp")
(const "smb"))))
+;;;###tramp-autoload
(defconst tramp-goa-methods '("gdrive" "nextcloud")
"List of methods which require registration at GNOME Online Accounts.")
@@ -154,15 +159,23 @@
(dolist (method tramp-goa-methods)
(setq tramp-gvfs-methods (delete method tramp-gvfs-methods))))
-;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'.
;;;###tramp-autoload
-(tramp--with-startup
- (when (string-match "\\(.+\\)@\\(\\(?:gmail\\|googlemail\\)\\.com\\)"
- user-mail-address)
- (add-to-list 'tramp-default-user-alist
- `("\\`gdrive\\'" nil ,(match-string 1 user-mail-address)))
- (add-to-list 'tramp-default-host-alist
- '("\\`gdrive\\'" nil ,(match-string 2 user-mail-address)))))
+(defvar tramp-media-methods '("afc" "gphoto2" "mtp")
+ "List of GVFS methods which are covered by the \"media\" method.
+They are checked during start up via
+`tramp-gvfs-interface-remotevolumemonitor'.")
+
+(defsubst tramp-gvfs-service-volumemonitor (method)
+ "Return the well known name of the volume monitor responsible for METHOD."
+ (symbol-value
+ (intern-soft (format "tramp-gvfs-service-%s-volumemonitor" method))))
+
+;; Remove media methods if not supported.
+(when tramp-gvfs-enabled
+ (dolist (method tramp-media-methods)
+ (unless (member (tramp-gvfs-service-volumemonitor method)
+ (dbus-list-known-names :session))
+ (setq tramp-media-methods (delete method tramp-media-methods)))))
;;;###tramp-autoload
(defcustom tramp-gvfs-zeroconf-domain "local"
@@ -172,13 +185,15 @@
:type 'string)
;; Add the methods to `tramp-methods', in order to allow minibuffer
-;; completion.
+;; completion. Add defaults for `tramp-default-host-alist'.
;;;###tramp-autoload
(when (featurep 'dbusbind)
(tramp--with-startup
- (dolist (elt tramp-gvfs-methods)
- (unless (assoc elt tramp-methods)
- (add-to-list 'tramp-methods (cons elt nil))))))
+ (dolist (method tramp-gvfs-methods)
+ (unless (assoc method tramp-methods)
+ (add-to-list 'tramp-methods `(,method)))
+ (when (member method tramp-goa-methods)
+ (add-to-list 'tramp-default-host-alist `(,method nil ""))))))
(defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp")
"The preceding object path for own objects.")
@@ -460,8 +475,209 @@ It has been changed in GVFS 1.14.")
;; </interface>
;; The basic structure for GNOME Online Accounts. We use a list :type,
-;; in order to be compatible with Emacs 24 and 25.
-(cl-defstruct (tramp-goa-name (:type list) :named) method user host port)
+;; in order to be compatible with Emacs 25.
+(cl-defstruct (tramp-goa-account (:type list) :named) method user host port)
+
+;;;###tramp-autoload
+(defconst tramp-gvfs-service-afc-volumemonitor "org.gtk.vfs.AfcVolumeMonitor"
+ "The well known name of the AFC volume monitor.")
+
+;; This one is not needed yet.
+(defconst tramp-gvfs-service-goa-volumemonitor "org.gtk.vfs.GoaVolumeMonitor"
+ "The well known name of the GOA volume monitor.")
+
+;;;###tramp-autoload
+(defconst tramp-gvfs-service-gphoto2-volumemonitor
+ "org.gtk.vfs.GPhoto2VolumeMonitor"
+ "The well known name of the GPhoto2 volume monitor.")
+
+;;;###tramp-autoload
+(defconst tramp-gvfs-service-mtp-volumemonitor "org.gtk.vfs.MTPVolumeMonitor"
+ "The well known name of the MTP volume monitor.")
+
+(defconst tramp-gvfs-path-remotevolumemonitor
+ "/org/gtk/Private/RemoteVolumeMonitor"
+ "The object path of the remote volume monitor.")
+
+(defconst tramp-gvfs-interface-remotevolumemonitor
+ "org.gtk.Private.RemoteVolumeMonitor"
+ "The volume monitor interface.")
+
+;; <interface name='org.gtk.Private.RemoteVolumeMonitor'>
+;; <method name="IsSupported">
+;; <arg type='b' name='is_supported' direction='out'/>
+;; </method>
+;; <method name="List">
+;; <arg type='a(ssssbbbbbbbbuasa{ss}sa{sv})' name='drives' direction='out'/>
+;; <arg type='a(ssssssbbssa{ss}sa{sv})' name='volumes' direction='out'/>
+;; <arg type='a(ssssssbsassa{sv})' name='mounts' direction='out'/>
+;; </method>
+;; <method name="CancelOperation">
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='b' name='was_cancelled' direction='out'/>
+;; </method>
+;; <method name="MountUnmount">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='unmount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="VolumeMount">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='mount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="DriveEject">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='unmount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="DrivePollForMedia">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; </method>
+;; <method name="DriveStart">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="DriveStop">
+;; <arg type='s' name='id' direction='in'/>
+;; <arg type='s' name='cancellation_id' direction='in'/>
+;; <arg type='u' name='unmount_flags' direction='in'/>
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; </method>
+;; <method name="MountOpReply">
+;; <arg type='s' name='mount_op_id' direction='in'/>
+;; <arg type='i' name='result' direction='in'/>
+;; <arg type='s' name='user_name' direction='in'/>
+;; <arg type='s' name='domain' direction='in'/>
+;; <arg type='s' name='encoded_password' direction='in'/>
+;; <arg type='i' name='password_save' direction='in'/>
+;; <arg type='i' name='choice' direction='in'/>
+;; <arg type='b' name='anonymous' direction='in'/>
+;; </method>
+;; <signal name="DriveChanged">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveConnected">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveDisconnected">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveEjectButton">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="DriveStopButton">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/>
+;; </signal>
+;; <signal name="VolumeChanged">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/>
+;; </signal>
+;; <signal name="VolumeAdded">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/>
+;; </signal>
+;; <signal name="VolumeRemoved">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/>
+;; </signal>
+;; <signal name="MountChanged">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountAdded">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountPreUnmount">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountRemoved">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='(ssssssbsassa{sv})' name='mount'/>
+;; </signal>
+;; <signal name="MountOpAskPassword">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='s' name='default_user'/>
+;; <arg type='s' name='default_domain'/>
+;; <arg type='u' name='flags'/>
+;; </signal>
+;; <signal name="MountOpAskQuestion">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='as' name='choices'/>
+;; </signal>
+;; <signal name="MountOpShowProcesses">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='ai' name='pid'/>
+;; <arg type='as' name='choices'/>
+;; </signal>
+;; <signal name="MountOpShowUnmountProgress">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; <arg type='s' name='message_to_show'/>
+;; <arg type='x' name='time_left'/>
+;; <arg type='x' name='bytes_left'/>
+;; </signal>
+;; <signal name="MountOpAborted">
+;; <arg type='s' name='dbus_name'/>
+;; <arg type='s' name='id'/>
+;; </signal>
+;; </interface>
+
+;; STRUCT volume
+;; STRING id
+;; STRING name
+;; STRING gicon_data
+;; STRING symbolic_gicon_data
+;; STRING uuid
+;; STRING activation_uri
+;; BOOLEAN can-mount
+;; BOOLEAN should-automount
+;; STRING drive-id
+;; STRING mount-id
+;; ARRAY identifiers
+;; DICT
+;; STRING key (unix-device, class, uuid, ...)
+;; STRING value
+;; STRING sort_key
+;; ARRAY expansion
+;; DICT
+;; STRING key (always-call-mount, is-removable, ...)
+;; VARIANT value (boolean?)
+
+;; The basic structure for media devices. We use a list :type, in
+;; order to be compatible with Emacs 25.
+(cl-defstruct (tramp-media-device (:type list) :named) method host port)
;; "gvfs-<command>" utilities have been deprecated in GVFS 1.31.1. We
;; must use "gio <command>" tool instead.
@@ -474,37 +690,38 @@ It has been changed in GVFS 1.14.")
("gvfs-mount" . "mount")
("gvfs-move" . "move")
("gvfs-rm" . "remove")
- ("gvfs-set-attribute" . "set")
- ("gvfs-trash" . "trash"))
+ ("gvfs-set-attribute" . "set"))
"List of cons cells, mapping \"gvfs-<command>\" to \"gio <command>\".")
;; <http://www.pygtk.org/docs/pygobject/gio-constants.html>
-(defconst tramp-gvfs-file-attributes
- '("name"
- "type"
- "standard::display-name"
- "standard::symlink-target"
- "standard::is-volatile"
- "unix::nlink"
- "unix::uid"
- "owner::user"
- "unix::gid"
- "owner::group"
- "time::access"
- "time::modified"
- "time::changed"
- "standard::size"
- "unix::mode"
- "access::can-read"
- "access::can-write"
- "access::can-execute"
- "unix::inode"
- "unix::device")
- "GVFS file attributes.")
-
-(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
- (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)")
- "Regexp to parse GVFS file attributes with `gvfs-ls'.")
+(eval-and-compile
+ (defconst tramp-gvfs-file-attributes
+ '("name"
+ "type"
+ "standard::display-name"
+ "standard::symlink-target"
+ "standard::is-volatile"
+ "unix::nlink"
+ "unix::uid"
+ "owner::user"
+ "unix::gid"
+ "owner::group"
+ "time::access"
+ "time::modified"
+ "time::changed"
+ "standard::size"
+ "unix::mode"
+ "access::can-read"
+ "access::can-write"
+ "access::can-execute"
+ "unix::inode"
+ "unix::device")
+ "GVFS file attributes."))
+
+(eval-and-compile
+ (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
+ (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)")
+ "Regexp to parse GVFS file attributes with `gvfs-ls'."))
(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
(concat "^[[:blank:]]*"
@@ -603,6 +820,8 @@ It has been changed in GVFS 1.14.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . tramp-gvfs-handle-get-remote-gid)
+ (tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
@@ -628,10 +847,9 @@ First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
(unless tramp-gvfs-enabled
(tramp-user-error nil "Package `tramp-gvfs' not supported"))
- (let ((fn (assoc operation tramp-gvfs-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let ((fn (assoc operation tramp-gvfs-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(when (featurep 'dbusbind)
@@ -645,20 +863,19 @@ pass to the OPERATION."
(defun tramp-gvfs-dbus-string-to-byte-array (string)
"Like `dbus-string-to-byte-array' but add trailing \\0 if needed."
(dbus-string-to-byte-array
- (if (string-match "^(aya{sv})" tramp-gvfs-mountlocation-signature)
+ (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature)
(concat string (string 0)) string)))
(defun tramp-gvfs-dbus-byte-array-to-string (byte-array)
"Like `dbus-byte-array-to-string' but remove trailing \\0 if exists.
Return nil for null BYTE-ARRAY."
;; The byte array could be a variant. Take care.
- (let ((byte-array
- (if (and (consp byte-array) (atom (car byte-array)))
- byte-array (car byte-array))))
- (and byte-array
- (dbus-byte-array-to-string
- (if (and (consp byte-array) (zerop (car (last byte-array))))
- (butlast byte-array) byte-array)))))
+ (when-let ((byte-array
+ (if (and (consp byte-array) (atom (car byte-array)))
+ byte-array (car byte-array))))
+ (dbus-byte-array-to-string
+ (if (and (consp byte-array) (zerop (car (last byte-array))))
+ (butlast byte-array) byte-array))))
(defun tramp-gvfs-stringify-dbus-message (message)
"Convert a D-Bus MESSAGE into readable UTF8 strings, used for traces."
@@ -683,6 +900,8 @@ The call will be traced by Tramp with trace level 6."
(tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result))
result))
+(put #'tramp-dbus-function 'tramp-suppress-trace t)
+
(defmacro with-tramp-dbus-call-method
(vec synchronous bus service path interface method &rest args)
"Apply a D-Bus call on bus BUS.
@@ -692,14 +911,15 @@ it is an asynchronous call, with `ignore' as callback function.
The other arguments have the same meaning as with `dbus-call-method'
or `dbus-call-method-asynchronously'."
+ (declare (indent 2) (debug t))
`(let ((func (if ,synchronous
#'dbus-call-method #'dbus-call-method-asynchronously))
(args (append (list ,bus ,service ,path ,interface ,method)
(if ,synchronous (list ,@args) (list 'ignore ,@args)))))
- (tramp-dbus-function ,vec func args)))
+ ;; We use `dbus-ignore-errors', because this macro is also called
+ ;; when loading.
+ (dbus-ignore-errors (tramp-dbus-function ,vec func args))))
-(put 'with-tramp-dbus-call-method 'lisp-indent-function 2)
-(put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>"))
(defmacro with-tramp-dbus-get-all-properties
@@ -707,6 +927,7 @@ or `dbus-call-method-asynchronously'."
"Return all properties of INTERFACE.
The call will be traced by Tramp with trace level 6."
;; Check, that interface exists at object path. Retrieve properties.
+ (declare (indent 1) (debug t))
`(when (member
,interface
(tramp-dbus-function
@@ -715,8 +936,6 @@ The call will be traced by Tramp with trace level 6."
(tramp-dbus-function
,vec #'dbus-get-all-properties (list ,bus ,service ,path ,interface))))
-(put 'with-tramp-dbus-get-all-properties 'lisp-indent-function 1)
-(put 'with-tramp-dbus-get-all-properties 'edebug-form-spec '(form symbolp body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-get-all-properties\\>"))
(defvar tramp-gvfs-dbus-event-vector nil
@@ -731,10 +950,10 @@ is no information where to trace the message.")
(tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
(add-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error)
-(add-hook
- 'tramp-gvfs-unload-hook
- (lambda ()
- (remove-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error)))
+(add-hook 'tramp-gvfs-unload-hook
+ (lambda ()
+ (remove-hook 'dbus-event-error-functions
+ #'tramp-gvfs-dbus-event-error)))
;; File name primitives.
@@ -768,6 +987,7 @@ file names."
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(equal-remote (tramp-equal-remote filename newname))
+ ;; "gvfs-rename" is not trustworthy.
(gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
@@ -779,7 +999,7 @@ file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(if (or (and equal-remote
@@ -840,8 +1060,8 @@ file names."
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -855,24 +1075,21 @@ file names."
(defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
- (with-parsed-tramp-file-name directory nil
+ (tramp-skeleton-delete-directory directory recursive trash
(if (and recursive (not (file-symlink-p directory)))
(mapc (lambda (file)
(if (eq t (tramp-compat-file-attribute-type
(file-attributes file)))
- (delete-directory file recursive trash)
- (delete-file file trash)))
+ (delete-directory file recursive)
+ (delete-file file)))
(directory-files
directory 'full directory-files-no-dot-files-regexp))
- (when (directory-files directory nil directory-files-no-dot-files-regexp)
+ (unless (tramp-compat-directory-empty-p directory)
(tramp-error
v 'file-error "Couldn't delete non-empty %s" directory)))
- (tramp-flush-directory-properties v localname)
- (unless
- (tramp-gvfs-send-command
- v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
- (tramp-gvfs-url-file-name directory))
+ (unless (tramp-gvfs-send-command
+ v "gvfs-rm" (tramp-gvfs-url-file-name directory))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -883,15 +1100,15 @@ file names."
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
- (unless
- (tramp-gvfs-send-command
- v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
- (tramp-gvfs-url-file-name filename))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error "Couldn't delete %s" filename)))))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash filename)
+ (unless (tramp-gvfs-send-command
+ v "gvfs-rm" (tramp-gvfs-url-file-name filename))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error "Couldn't delete %s" filename))))))
(defun tramp-gvfs-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
@@ -957,10 +1174,11 @@ file names."
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(while (looking-at
- (concat "^\\(.+\\)[[:blank:]]"
- "\\([[:digit:]]+\\)[[:blank:]]"
- "(\\(.+?\\))"
- tramp-gvfs-file-attributes-with-gvfs-ls-regexp))
+ (eval-when-compile
+ (concat "^\\(.+\\)[[:blank:]]"
+ "\\([[:digit:]]+\\)[[:blank:]]"
+ "(\\(.+?\\))"
+ tramp-gvfs-file-attributes-with-gvfs-ls-regexp)))
(let ((item (list (cons "type" (match-string 3))
(cons "standard::size" (match-string 2))
(cons "name" (match-string 1)))))
@@ -1061,8 +1279,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::uid" attributes))
- (eval-when-compile
- (format "%s" tramp-unknown-id-integer))))
+ (eval-when-compile (format "%s" tramp-unknown-id-integer))))
(or (cdr (assoc "owner::user" attributes))
(cdr (assoc "unix::uid" attributes))
tramp-unknown-id-string)))
@@ -1070,8 +1287,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::gid" attributes))
- (eval-when-compile
- (format "%s" tramp-unknown-id-integer))))
+ (eval-when-compile (format "%s" tramp-unknown-id-integer))))
(or (cdr (assoc "owner::group" attributes))
(cdr (assoc "unix::gid" attributes))
tramp-unknown-id-string)))
@@ -1251,11 +1467,11 @@ If FILE-SYSTEM is non-nil, return file system attributes."
;; File names are returned as URL paths. We must convert them.
(when (string-match ddu file)
(setq file (replace-match dd nil nil file)))
- (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" file)
+ (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" file)
(setq file (url-unhex-string file)))
(when (string-match ddu (or file1 ""))
(setq file1 (replace-match dd nil nil file1)))
- (while (string-match-p "%\\([0-9A-F]\\{2\\}\\)" (or file1 ""))
+ (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" (or file1 ""))
(setq file1 (url-unhex-string file1)))
;; Remove watch when file or directory to be watched is deleted.
(when (and (member action '(moved deleted))
@@ -1288,7 +1504,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
;; If the user is different from what we guess to be
;; the user, we don't know. Let's check, whether
;; access is restricted explicitly.
- (and (/= (tramp-gvfs-get-remote-uid v 'integer)
+ (and (/= (tramp-get-remote-uid v 'integer)
(tramp-compat-file-attribute-user-id
(file-attributes filename 'integer)))
(not
@@ -1338,8 +1554,8 @@ If FILE-SYSTEM is non-nil, return file system attributes."
"Like `rename-file' for Tramp files."
;; Check if both files are local -- invoke normal rename-file.
;; Otherwise, use Tramp from local system.
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -1349,78 +1565,110 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(tramp-run-real-handler
#'rename-file (list filename newname ok-if-already-exists))))
-(defun tramp-gvfs-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-gvfs-send-command
- v "gvfs-set-attribute" "-t" "uint32"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
- "unix::mode" (number-to-string mode))))
+ v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint32"
+ (tramp-gvfs-url-file-name filename) "unix::mode" (number-to-string mode))))
-(defun tramp-gvfs-handle-set-file-times (filename &optional time _flag)
+(defun tramp-gvfs-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
- (let ((time
- (if (or (null time)
+ (tramp-gvfs-send-command
+ v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint64"
+ (tramp-gvfs-url-file-name filename) "time::modified"
+ (format-time-string
+ "%s" (if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
(current-time)
- time)))
- (tramp-gvfs-send-command
- v "gvfs-set-attribute" "-t" "uint64"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
- "time::modified" (format-time-string "%s" time)))))
+ time)))))
+
+(defun tramp-gvfs-handle-get-remote-uid (vec id-format)
+ "The uid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (if (equal id-format 'string)
+ (tramp-file-name-user vec)
+ (when-let
+ ((localname (tramp-get-connection-property vec "default-location" nil)))
+ (tramp-compat-file-attribute-user-id
+ (file-attributes
+ (tramp-make-tramp-file-name vec localname) id-format)))))
+
+(defun tramp-gvfs-handle-get-remote-gid (vec id-format)
+ "The gid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (when-let
+ ((localname (tramp-get-connection-property vec "default-location" nil)))
+ (tramp-compat-file-attribute-group-id
+ (file-attributes
+ (tramp-make-tramp-file-name vec localname) id-format))))
-(defun tramp-gvfs-set-file-uid-gid (filename &optional uid gid)
+(defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(when (natnump uid)
(tramp-gvfs-send-command
v "gvfs-set-attribute" "-t" "uint32"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
- "unix::uid" (number-to-string uid)))
+ (tramp-gvfs-url-file-name filename) "unix::uid" (number-to-string uid)))
(when (natnump gid)
(tramp-gvfs-send-command
v "gvfs-set-attribute" "-t" "uint32"
- (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
+ (tramp-gvfs-url-file-name filename)
"unix::gid" (number-to-string gid)))))
;; File name conversions.
+(defun tramp-gvfs-activation-uri (filename)
+ "Return activation URI to be used in gio commands."
+ (if (tramp-tramp-file-p filename)
+ (with-parsed-tramp-file-name filename nil
+ ;; Ensure that media devices are cached.
+ (when (string-equal method "media")
+ (tramp-get-media-device v))
+ (with-tramp-connection-property v "activation-uri"
+ (setq localname "/")
+ (when (string-equal "gdrive" method)
+ (setq method "google-drive"))
+ (when (string-equal "nextcloud" method)
+ (setq method "davs"
+ localname
+ (concat (tramp-gvfs-get-remote-prefix v) localname)))
+ (when (string-equal "media" method)
+ (when-let
+ ((media (tramp-get-connection-property v "media-device" nil)))
+ (setq method (tramp-media-device-method media)
+ host (tramp-media-device-host media)
+ port (tramp-media-device-port media))))
+ (when (and user domain)
+ (setq user (concat domain ";" user)))
+ (url-recreate-url
+ (url-parse-make-urlobj
+ method (and user (url-hexify-string user))
+ nil (and host (url-hexify-string host))
+ (if (stringp port) (string-to-number port) port)
+ localname nil nil t))))
+ ;; Local URI.
+ (url-recreate-url
+ (url-parse-make-urlobj "file" nil nil nil nil nil nil nil t))))
+
(defun tramp-gvfs-url-file-name (filename)
"Return FILENAME in URL syntax."
- ;; "/" must NOT be hexified.
(setq filename (tramp-compat-file-name-unquote filename))
- (let ((url-unreserved-chars (cons ?/ url-unreserved-chars))
- result)
- (setq
- result
- (url-recreate-url
- (if (tramp-tramp-file-p filename)
- (with-parsed-tramp-file-name filename nil
- (when (string-equal "gdrive" method)
- (setq method "google-drive"))
- (when (string-equal "nextcloud" method)
- (setq method "davs"
- localname
- (concat (tramp-gvfs-get-remote-prefix v) localname)))
- (when (and user domain)
- (setq user (concat domain ";" user)))
- (url-parse-make-urlobj
- method (and user (url-hexify-string user))
- nil (and host (url-hexify-string host))
- (if (stringp port) (string-to-number port) port)
- (and localname (url-hexify-string localname)) nil nil t))
- (url-parse-make-urlobj
- "file" nil nil nil nil
- (url-hexify-string (file-truename filename)) nil nil t))))
+ (let* (;; "/" must NOT be hexified.
+ (url-unreserved-chars (cons ?/ url-unreserved-chars))
+ (result
+ (concat (substring (tramp-gvfs-activation-uri filename) 0 -1)
+ (url-hexify-string (tramp-file-local-name filename)))))
(when (tramp-tramp-file-p filename)
- (with-parsed-tramp-file-name filename nil
- (tramp-message v 10 "remote file `%s' is URL `%s'" filename result)))
+ (tramp-message
+ (tramp-dissect-file-name filename) 10
+ "remote file `%s' is URL `%s'" filename result))
result))
(defun tramp-gvfs-object-path (filename)
@@ -1432,6 +1680,14 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(dbus-unescape-from-identifier
(replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
+(defun tramp-gvfs-url-host (url)
+ "Return the host name part of URL, a string.
+We cannot use `url-host', because `url-generic-parse-url' returns
+a downcased host name only."
+ (and (stringp url)
+ (string-match "^[[:alnum:]]+://\\([^/:]+\\)" url)
+ (match-string 1 url)))
+
;; D-Bus GVFS functions.
@@ -1498,8 +1754,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(list
t ;; handled.
nil ;; no abort of D-Bus.
- (with-tramp-connection-property
- (tramp-get-connection-process v) message
+ (with-tramp-connection-property (tramp-get-process v) message
;; In theory, there can be several choices.
;; Until now, there is only the question whether
;; to accept an unknown host signature or certificate.
@@ -1572,11 +1827,22 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(when (string-equal "google-drive" method)
(setq method "gdrive"))
(when (and (string-equal "http" method) (stringp uri))
- (setq uri (url-generic-parse-url uri)
+ (setq host (tramp-gvfs-url-host uri)
+ uri (url-generic-parse-url uri)
method (url-type uri)
user (url-user uri)
- host (url-host uri)
port (url-portspec uri)))
+ (when (member method tramp-media-methods)
+ ;; Ensure that media devices are cached.
+ (tramp-get-media-devices nil)
+ (let ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector" nil)))
+ (when v
+ (setq method (tramp-file-name-method v)
+ host (tramp-file-name-host v)
+ port (tramp-file-name-port v)))))
(when (member method tramp-gvfs-methods)
(with-parsed-tramp-file-name
(tramp-make-tramp-file-name method user domain host port "") nil
@@ -1662,11 +1928,22 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(when (string-equal "google-drive" method)
(setq method "gdrive"))
(when (and (string-equal "http" method) (stringp uri))
- (setq uri (url-generic-parse-url uri)
+ (setq host (tramp-gvfs-url-host uri)
+ uri (url-generic-parse-url uri)
method (url-type uri)
user (url-user uri)
- host (url-host uri)
port (url-portspec uri)))
+ (when (member method tramp-media-methods)
+ ;; Ensure that media devices are cached.
+ (tramp-get-media-devices vec)
+ (let ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector" nil)))
+ (when v
+ (setq method (tramp-file-name-method v)
+ host (tramp-file-name-host v)
+ port (tramp-file-name-port v)))))
(when (and
(string-equal method (tramp-file-name-method vec))
(string-equal user (tramp-file-name-user vec))
@@ -1691,8 +1968,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(tramp-gvfs-url-file-name (tramp-make-tramp-file-name vec))))
(while (tramp-gvfs-connection-mounted-p vec)
(read-event nil nil 0.1))
- (tramp-flush-connection-properties vec)
- (tramp-flush-connection-properties (tramp-get-connection-process vec)))
+ (tramp-cleanup-connection vec 'keep-debug 'keep-password))
(defun tramp-gvfs-mount-spec-entry (key value)
"Construct a mount-spec entry to be used in a mount_spec.
@@ -1704,11 +1980,16 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(defun tramp-gvfs-mount-spec (vec)
"Return a mount-spec for \"org.gtk.vfs.MountTracker.mountLocation\"."
- (let* ((method (tramp-file-name-method vec))
+ (let* ((media (tramp-get-media-device vec))
+ (method (if media
+ (tramp-media-device-method media)
+ (tramp-file-name-method vec)))
(user (tramp-file-name-user vec))
(domain (tramp-file-name-domain vec))
- (host (tramp-file-name-host vec))
- (port (tramp-file-name-port vec))
+ (host (if media
+ (tramp-media-device-host media) (tramp-file-name-host vec)))
+ (port (if media
+ (tramp-media-device-port media) (tramp-file-name-port vec)))
(localname (tramp-file-name-unquote-localname vec))
(share (when (string-match "^/?\\([^/]+\\)" localname)
(match-string 1 localname)))
@@ -1759,42 +2040,41 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
;; Return.
`(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec)))
+(defun tramp-gvfs-handler-volumeadded-volumeremoved (_dbus-name _id volume)
+ "Signal handler for the \"org.gtk.Private.RemoteVolumeMonitor.VolumeAdded\" \
+and \"org.gtk.Private.RemoteVolumeMonitor.VolumeRemoved\" signals."
+ (ignore-errors
+ (let* ((signal-name (dbus-event-member-name last-input-event))
+ (uri (url-generic-parse-url (nth 5 volume)))
+ (method (url-type uri))
+ (vec (make-tramp-file-name
+ :method "media"
+ ;; A host name cannot contain spaces.
+ :host (replace-regexp-in-string " " "_" (nth 1 volume))))
+ (media (make-tramp-media-device
+ :method method
+ :host (tramp-gvfs-url-host (nth 5 volume))
+ :port (and (url-portspec uri)))))
+ (when (member method tramp-media-methods)
+ (tramp-message
+ vec 6 "%s %s" signal-name (tramp-gvfs-stringify-dbus-message volume))
+ (tramp-flush-connection-properties vec)
+ (tramp-flush-connection-properties media)
+ (tramp-get-media-devices nil)))))
+
+(when tramp-gvfs-enabled
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-remotevolumemonitor
+ tramp-gvfs-interface-remotevolumemonitor "VolumeAdded"
+ #'tramp-gvfs-handler-volumeadded-volumeremoved)
+ (dbus-register-signal
+ :session nil tramp-gvfs-path-remotevolumemonitor
+ tramp-gvfs-interface-remotevolumemonitor "VolumeRemoved"
+ #'tramp-gvfs-handler-volumeadded-volumeremoved))
+
;; Connection functions.
-(defun tramp-gvfs-get-remote-uid (vec id-format)
- "The uid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (let ((user (tramp-file-name-user vec))
- (localname
- (tramp-get-connection-property vec "default-location" nil)))
- (cond
- ((and (equal id-format 'string) user))
- (localname
- (tramp-compat-file-attribute-user-id
- (file-attributes
- (tramp-make-tramp-file-name vec localname) id-format)))
- ((equal id-format 'integer) tramp-unknown-id-integer)
- ((equal id-format 'string) tramp-unknown-id-string)))))
-
-(defun tramp-gvfs-get-remote-gid (vec id-format)
- "The gid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "gid-%s" id-format)
- (let ((localname
- (tramp-get-connection-property vec "default-location" nil)))
- (cond
- (localname
- (tramp-compat-file-attribute-group-id
- (file-attributes
- (tramp-make-tramp-file-name vec localname) id-format)))
- ((equal id-format 'integer) tramp-unknown-id-integer)
- ((equal id-format 'string) tramp-unknown-id-string)))))
-
-(defvar tramp-gvfs-get-remote-uid-gid-in-progress nil
- "Indication, that remote uid and gid determination is in progress.")
-
(defun tramp-gvfs-get-remote-prefix (vec)
"The prefix of the remote connection VEC.
This is relevant for GNOME Online Accounts."
@@ -1802,7 +2082,7 @@ This is relevant for GNOME Online Accounts."
;; Ensure that GNOME Online Accounts are cached.
(when (member (tramp-file-name-method vec) tramp-goa-methods)
(tramp-get-goa-accounts vec))
- (tramp-get-connection-property (tramp-make-goa-name vec) "prefix" "/")))
+ (tramp-get-connection-property (tramp-get-goa-account vec) "prefix" "/")))
(defun tramp-gvfs-maybe-open-connection (vec)
"Maybe open a connection VEC.
@@ -1851,7 +2131,7 @@ connection if a previous connection has died for some reason."
;; Ensure that GNOME Online Accounts are cached.
(tramp-get-goa-accounts vec)
(when (tramp-get-connection-property
- (tramp-make-goa-name vec) "FilesDisabled" t)
+ (tramp-get-goa-account vec) "FilesDisabled" t)
(tramp-user-error
vec "There is no Online Account `%s'"
(tramp-make-tramp-file-name vec 'noloc))))
@@ -1934,16 +2214,7 @@ connection if a previous connection has died for some reason."
;; Mark it as connected.
(tramp-set-connection-property
- (tramp-get-connection-process vec) "connected" t))))
-
- ;; In `tramp-check-cached-permissions', the connection properties
- ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
- (unless tramp-gvfs-get-remote-uid-gid-in-progress
- (let ((tramp-gvfs-get-remote-uid-gid-in-progress t))
- (tramp-gvfs-get-remote-uid vec 'integer)
- (tramp-gvfs-get-remote-gid vec 'integer)
- (tramp-gvfs-get-remote-uid vec 'string)
- (tramp-gvfs-get-remote-gid vec 'string))))
+ (tramp-get-connection-process vec) "connected" t)))))
(defun tramp-gvfs-gio-tool-p (vec)
"Check, whether the gio tool is available."
@@ -1976,12 +2247,12 @@ is applied, and it returns t if the return code is zero."
(and (tramp-flush-file-properties vec "/") nil)))))
-;; D-Bus GNOME Online Accounts functions.
+;; GNOME Online Accounts functions.
-(defun tramp-make-goa-name (vec)
- "Transform VEC into a `tramp-goa-name' structure."
+(defun tramp-get-goa-account (vec)
+ "Transform VEC into a `tramp-goa-account' structure."
(when (tramp-file-name-p vec)
- (make-tramp-goa-name
+ (make-tramp-goa-account
:method (tramp-file-name-method vec)
:user (tramp-file-name-user vec)
:host (tramp-file-name-host vec)
@@ -1989,12 +2260,12 @@ is applied, and it returns t if the return code is zero."
(defun tramp-get-goa-accounts (vec)
"Retrieve GNOME Online Accounts, and cache them.
-The hash key is a `tramp-goa-name' structure. The value is an
+The hash key is a `tramp-goa-account' structure. The value is an
alist of the properties of `tramp-goa-interface-account' and
-`tramp-goa-interface-files' of the corresponding GNOME online
-account. Additionally, a property \"prefix\" is added.
+`tramp-goa-interface-files' of the corresponding GNOME Online
+Account. Additionally, a property \"prefix\" is added.
VEC is used only for traces."
- (with-tramp-connection-property (tramp-make-goa-name vec) "goa-accounts"
+ (with-tramp-connection-property nil "goa-accounts"
(dolist
(object-path
(mapcar
@@ -2020,15 +2291,15 @@ VEC is used only for traces."
(cdr (assoc "ProviderType" account-properties))
'("google" "owncloud"))
(string-match tramp-goa-identity-regexp identity))
- (setq key (make-tramp-goa-name
+ (setq key (make-tramp-goa-account
:method (cdr (assoc "ProviderType" account-properties))
:user (match-string 1 identity)
:host (match-string 2 identity)
:port (match-string 3 identity)))
- (when (string-equal (tramp-goa-name-method key) "google")
- (setf (tramp-goa-name-method key) "gdrive"))
- (when (string-equal (tramp-goa-name-method key) "owncloud")
- (setf (tramp-goa-name-method key) "nextcloud"))
+ (when (string-equal (tramp-goa-account-method key) "google")
+ (setf (tramp-goa-account-method key) "gdrive"))
+ (when (string-equal (tramp-goa-account-method key) "owncloud")
+ (setf (tramp-goa-account-method key) "nextcloud"))
;; Cache all properties.
(dolist (prop (nconc account-properties files-properties))
(tramp-set-connection-property key (car prop) (cdr prop)))
@@ -2044,6 +2315,80 @@ VEC is used only for traces."
;; Mark, that goa accounts have been cached.
"cached"))
+(defun tramp-parse-goa-accounts (service)
+ "Return a list of (user host) tuples allowed to access.
+It checks for registered GNOME Online Accounts."
+ ;; SERVICE might be encoded as a DNS-SD service.
+ (and (string-match tramp-dns-sd-service-regexp service)
+ (setq service (match-string 1 service)))
+ (mapcar
+ (lambda (key)
+ (and (tramp-goa-account-p key)
+ (string-equal service (tramp-goa-account-method key))
+ (list (tramp-goa-account-user key)
+ (tramp-goa-account-host key))))
+ (hash-table-keys tramp-cache-data)))
+
+
+;; Media devices functions.
+
+(defun tramp-get-media-device (vec)
+ "Transform VEC into a `tramp-media-device' structure.
+Check, that respective cache values do exist."
+ (if-let ((media (tramp-get-connection-property vec "media-device" nil))
+ (prop (tramp-get-connection-property media "vector" nil)))
+ media
+ (tramp-get-media-devices vec)
+ (tramp-get-connection-property vec "media-device" nil)))
+
+(defun tramp-get-media-devices (vec)
+ "Retrieve media devices, and cache them.
+The hash key is a `tramp-media-device' structure.
+VEC is used only for traces."
+ (let (devices)
+ (dolist (method tramp-media-methods)
+ (dolist (volume (cadr (with-tramp-dbus-call-method vec t
+ :session (tramp-gvfs-service-volumemonitor method)
+ tramp-gvfs-path-remotevolumemonitor
+ tramp-gvfs-interface-remotevolumemonitor "List")))
+ (let* ((uri (url-generic-parse-url (nth 5 volume)))
+ (vec (make-tramp-file-name
+ :method "media"
+ ;; A host name cannot contain spaces.
+ :host (replace-regexp-in-string " " "_" (nth 1 volume))))
+ (media (make-tramp-media-device
+ :method method
+ :host (tramp-gvfs-url-host (nth 5 volume))
+ :port (and (url-portspec uri)
+ (number-to-string (url-portspec uri))))))
+ (push (tramp-file-name-host vec) devices)
+ (tramp-set-connection-property vec "activation-uri" (nth 5 volume))
+ (tramp-set-connection-property vec "media-device" media)
+ (tramp-set-connection-property media "vector" vec))))
+
+ ;; Adapt default host name, supporting /media:: when possible.
+ (setq tramp-default-host-alist
+ (append
+ `(("media" nil ,(if (= (length devices) 1) (car devices) "")))
+ (delete
+ (assoc "media" tramp-default-host-alist)
+ tramp-default-host-alist)))))
+
+(defun tramp-parse-media-names (service)
+ "Return a list of (user host) tuples allowed to access.
+It checks for mounted media devices."
+ ;; SERVICE might be encoded as a DNS-SD service.
+ (and (string-match tramp-dns-sd-service-regexp service)
+ (setq service (match-string 1 service)))
+ (mapcar
+ (lambda (key)
+ (and (tramp-media-device-p key)
+ (string-equal service (tramp-media-device-method key))
+ (tramp-get-connection-property key "vector" nil)
+ (list nil (tramp-file-name-host
+ (tramp-get-connection-property key "vector" nil)))))
+ (hash-table-keys tramp-cache-data)))
+
;; D-Bus zeroconf functions.
@@ -2088,42 +2433,65 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
(list user host)))
result))))
-;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods.
(when tramp-gvfs-enabled
- ;; Suppress D-Bus error messages.
- (let (tramp-gvfs-dbus-event-vector
- ;; Sometimes, it fails with "Variable binding depth exceeds
+ ;; Suppress D-Bus error messages and Tramp traces.
+ (let (;; Sometimes, it fails with "Variable binding depth exceeds
;; max-specpdl-size". Shall be fixed in Emacs 27.
- (max-specpdl-size (* 2 max-specpdl-size)))
+ (max-specpdl-size (* 2 max-specpdl-size))
+ (tramp-verbose 0)
+ tramp-gvfs-dbus-event-vector fun)
+ ;; Add completion functions for services announced by DNS-SD.
+ ;; See <http://www.dns-sd.org/ServiceTypes.html> for valid service types.
(zeroconf-init tramp-gvfs-zeroconf-domain)
- (if (zeroconf-list-service-types)
- (progn
- (tramp-set-completion-function
- "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp")))
- (tramp-set-completion-function
- "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
- (tramp-set-completion-function
- "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
- (tramp-set-completion-function
- "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp")
- (tramp-zeroconf-parse-device-names "_workstation._tcp")))
- (when (member "smb" tramp-gvfs-methods)
- (tramp-set-completion-function
- "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp")))))
-
- (when (executable-find "avahi-browse")
+ (when (setq fun (or (and (zeroconf-list-service-types)
+ #'tramp-zeroconf-parse-device-names)
+ (and (executable-find "avahi-browse")
+ #'tramp-gvfs-parse-device-names)))
+ (when (member "afp" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "afp" `((,fun "_afpovertcp._tcp"))))
+ (when (member "dav" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "dav" `((,fun "_webdav._tcp")
+ (,fun "_webdavs._tcp"))))
+ (when (member "davs" tramp-gvfs-methods)
(tramp-set-completion-function
- "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
+ "davs" `((,fun "_webdav._tcp")
+ (,fun "_webdavs._tcp"))))
+ (when (member "ftp" tramp-gvfs-methods)
(tramp-set-completion-function
- "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
+ "ftp" `((,fun "_ftp._tcp"))))
+ (when (member "http" tramp-gvfs-methods)
(tramp-set-completion-function
- "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
+ "http" `((,fun "_http._tcp")
+ (,fun "_https._tcp"))))
+ (when (member "https" tramp-gvfs-methods)
(tramp-set-completion-function
- "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
- (tramp-gvfs-parse-device-names "_workstation._tcp")))
- (when (member "smb" tramp-gvfs-methods)
- (tramp-set-completion-function
- "smb" '((tramp-gvfs-parse-device-names "_smb._tcp"))))))))
+ "https" `((,fun "_http._tcp")
+ (,fun "_https._tcp"))))
+ (when (member "sftp" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "sftp" `((,fun "_sftp-ssh._tcp")
+ (,fun "_ssh._tcp")
+ (,fun "_workstation._tcp"))))
+ (when (member "smb" tramp-gvfs-methods)
+ (tramp-set-completion-function
+ "smb" `((,fun "_smb._tcp")))))
+
+ ;; Add completion functions for GNOME Online Accounts.
+ (tramp-get-goa-accounts nil)
+ (dolist (method tramp-goa-methods)
+ (when (member method tramp-gvfs-methods)
+ (tramp-set-completion-function
+ method `((tramp-parse-goa-accounts ,(format "_%s._tcp" method))))))
+
+ ;; Add completion functions for media devices.
+ (tramp-get-media-devices nil)
+ (tramp-set-completion-function
+ "media"
+ (mapcar
+ (lambda (method) `(tramp-parse-media-names ,(format "_%s._tcp" method)))
+ tramp-media-methods))))
(add-hook 'tramp-unload-hook
(lambda ()
@@ -2136,7 +2504,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el.
;;
;; * Host name completion for existing mount points (afp-server,
-;; smb-server, google-drive, nextcloud) or via smb-network or network.
+;; smb-server) or via smb-network or network.
;;
;; * Check, how two shares of the same SMB server can be mounted in
;; parallel.
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 1567a24e272..4790bb453d3 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -135,6 +135,8 @@
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . ignore)
+ (tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
@@ -157,10 +159,9 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
"Invoke the rclone handler for OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
- (let ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(tramp--with-startup
@@ -220,7 +221,7 @@ file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(if (or (and t1 (not (tramp-rclone-file-name-p filename)))
@@ -271,8 +272,8 @@ file names."
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -288,19 +289,19 @@ file names."
(directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name directory) nil
- (delete-directory (tramp-rclone-local-file-name directory) recursive trash)
(tramp-flush-directory-properties v localname)
- (tramp-rclone-flush-directory-cache v)))
+ (tramp-rclone-flush-directory-cache v)
+ (delete-directory (tramp-rclone-local-file-name directory) recursive trash)))
(defun tramp-rclone-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-rclone-flush-directory-cache v)
(delete-file (tramp-rclone-local-file-name filename) trash)
- (tramp-flush-file-properties v localname)
- (tramp-rclone-flush-directory-cache v)))
+ (tramp-flush-file-properties v localname)))
(defun tramp-rclone-handle-directory-files
- (directory &optional full match nosort _count)
+ (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -310,8 +311,8 @@ file names."
(setq directory (file-name-as-directory (expand-file-name directory)))
(with-parsed-tramp-file-name directory nil
(let ((result
- (directory-files
- (tramp-rclone-local-file-name directory) full match)))
+ (tramp-compat-directory-files
+ (tramp-rclone-local-file-name directory) full match nosort count)))
;; Massage the result.
(when full
(let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v))))
@@ -429,8 +430,8 @@ file names."
(defun tramp-rclone-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -458,7 +459,7 @@ file names."
;; to cache a nil result.
(or (tramp-get-connection-property
(tramp-get-connection-process vec) "mounted" nil)
- (let* ((default-directory temporary-file-directory)
+ (let* ((default-directory (tramp-compat-temporary-file-directory))
(mount (shell-command-to-string "mount -t fuse.rclone")))
(tramp-message vec 6 "%s" "mount -t fuse.rclone")
(tramp-message vec 6 "\n%s" mount)
@@ -484,7 +485,8 @@ file names."
;; crash Emacs for some processes. So we use
;; "pidof", which might not work everywhere.
(if (<= emacs-major-version 25)
- (let ((default-directory temporary-file-directory))
+ (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
(mapcar
#'string-to-number
(split-string
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 4dca040aebb..ccf0c0d0e28 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -91,10 +91,10 @@ the default storage location, e.g. \"$HOME/.sh_history\"."
(string :tag "Redirect to a file")))
;;;###tramp-autoload
-(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m"
+(defconst tramp-display-escape-sequence-regexp "\e[[:digit:];[]+m"
"Terminal control escape sequences for display attributes.")
-(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n"
+(defconst tramp-device-escape-sequence-regexp "\e[[:digit:][]+n"
"Terminal control escape sequences for device status.")
;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
@@ -118,7 +118,9 @@ detected as prompt when being sent on echoing hosts, therefore.")
;;;###tramp-autoload
(defcustom tramp-use-ssh-controlmaster-options t
- "Whether to use `tramp-ssh-controlmaster-options'."
+ "Whether to use `tramp-ssh-controlmaster-options'.
+Set it to nil, if you use Control* or Proxy* options in your ssh
+configuration."
:group 'tramp
:version "24.4"
:type 'boolean)
@@ -478,10 +480,11 @@ The string is used in `tramp-methods'.")
;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin
-;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
+;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin
;; IRIX64: /usr/bin
;; QNAP QTS: ---
+;; Hydra: /run/current-system/sw/bin:/bin:/usr/bin
;;;###tramp-autoload
(defcustom tramp-remote-path
'(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin"
@@ -492,8 +495,8 @@ The string is used in `tramp-methods'.")
For every remote host, this variable will be set buffer local,
keeping the list of existing directories on that host.
-You can use `~' in this list, but when searching for a shell which groks
-tilde expansion, all directory names starting with `~' will be ignored.
+You can use \"~\" in this list, but when searching for a shell which groks
+tilde expansion, all directory names starting with \"~\" will be ignored.
`Default Directories' represent the list of directories given by
the command \"getconf PATH\". It is recommended to use this
@@ -1039,6 +1042,8 @@ of command line.")
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . tramp-sh-handle-get-remote-gid)
+ (tramp-get-remote-uid . tramp-sh-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
(vc-registered . tramp-sh-handle-vc-registered)
@@ -1116,8 +1121,7 @@ component is used as the target of the symlink."
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
(funcall
- (if (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
+ (if (directory-name-p filename) #'file-name-as-directory #'identity)
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
@@ -1154,59 +1158,9 @@ component is used as the target of the symlink."
(tramp-shell-quote-argument localname)))))
;; Do it yourself.
- (t (let ((steps (split-string localname "/" 'omit))
- (thisstep nil)
- (numchase 0)
- ;; Don't make the following value larger than
- ;; necessary. People expect an error message in a
- ;; timely fashion when something is wrong;
- ;; otherwise they might think that Emacs is hung.
- ;; Of course, correctness has to come first.
- (numchase-limit 20)
- symlink-target)
- (while (and steps (< numchase numchase-limit))
- (setq thisstep (pop steps))
- (tramp-message
- v 5 "Check %s"
- (string-join
- (append '("") (reverse result) (list thisstep)) "/"))
- (setq symlink-target
- (tramp-compat-file-attribute-type
- (file-attributes
- (tramp-make-tramp-file-name
- v
- (string-join
- (append
- '("") (reverse result) (list thisstep)) "/")
- 'nohop))))
- (cond ((string= "." thisstep)
- (tramp-message v 5 "Ignoring step `.'"))
- ((string= ".." thisstep)
- (tramp-message v 5 "Processing step `..'")
- (pop result))
- ((stringp symlink-target)
- ;; It's a symlink, follow it.
- (tramp-message
- v 5 "Follow symlink to %s" symlink-target)
- (setq numchase (1+ numchase))
- (when (file-name-absolute-p symlink-target)
- (setq result nil))
- (setq steps
- (append
- (split-string symlink-target "/" 'omit)
- steps)))
- (t
- ;; It's a file.
- (setq result (cons thisstep result)))))
- (when (>= numchase numchase-limit)
- (tramp-error
- v 'file-error
- "Maximum number (%d) of symlinks exceeded" numchase-limit))
- (setq result (reverse result))
- ;; Combine list to form string.
- (setq result
- (if result (string-join (cons "" result) "/") "/"))
- (when (string-empty-p result) (setq result "/")))))
+ (t (setq
+ result
+ (tramp-file-local-name (tramp-handle-file-truename filename)))))
;; Detect cycle.
(when (and (file-symlink-p filename)
@@ -1378,13 +1332,12 @@ component is used as the target of the symlink."
(tramp-send-command-and-read
vec
(format
- (eval-when-compile
- (concat
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell escape
- ;; of them in file names.
- "(%s -c '((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' %s |"
- " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g')"))
+ (concat
+ ;; Apostrophes in the stat output are masked as
+ ;; `tramp-stat-marker', in order to make a proper shell escape of
+ ;; them in file names.
+ "(%s -c '((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' %s |"
+ " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g')")
(tramp-get-remote-stat vec)
tramp-stat-marker tramp-stat-marker
(if (eq id-format 'integer)
@@ -1474,17 +1427,24 @@ of."
;; only if that agrees with the buffer's record.
(t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))))
-(defun tramp-sh-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-sh-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
- ;; FIXME: extract the proper text from chmod's stderr.
- (tramp-barf-unless-okay
- v
- (format "chmod %o %s" mode (tramp-shell-quote-argument localname))
- "Error while changing file's mode %s" filename)))
+ ;; We need "chmod -h" when the flag is set.
+ (when (or (not (eq flag 'nofollow))
+ (not (file-symlink-p filename))
+ (tramp-get-remote-chmod-h v))
+ (tramp-flush-file-properties v localname)
+ ;; FIXME: extract the proper text from chmod's stderr.
+ (tramp-barf-unless-okay
+ v
+ (format
+ "chmod %s %o %s"
+ (if (and (eq flag 'nofollow) (tramp-get-remote-chmod-h v)) "-h" "")
+ mode (tramp-shell-quote-argument localname))
+ "Error while changing file's mode %s" filename))))
-(defun tramp-sh-handle-set-file-times (filename &optional time _flag)
+(defun tramp-sh-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(when (tramp-get-remote-touch v)
@@ -1497,13 +1457,34 @@ of."
time)))
(tramp-send-command-and-check
v (format
- "env TZ=UTC %s %s %s"
+ "env TZ=UTC %s %s %s %s"
(tramp-get-remote-touch v)
(if (tramp-get-connection-property v "touch-t" nil)
(format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t))
"")
+ (if (eq flag 'nofollow) "-h" "")
(tramp-shell-quote-argument localname)))))))
+(defun tramp-sh-handle-get-remote-uid (vec id-format)
+ "The uid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (ignore-errors
+ (cond
+ ((tramp-get-remote-id vec) (tramp-get-remote-uid-with-id vec id-format))
+ ((tramp-get-remote-perl vec) (tramp-get-remote-uid-with-perl vec id-format))
+ ((tramp-get-remote-python vec)
+ (tramp-get-remote-uid-with-python vec id-format)))))
+
+(defun tramp-sh-handle-get-remote-gid (vec id-format)
+ "The gid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (ignore-errors
+ (cond
+ ((tramp-get-remote-id vec) (tramp-get-remote-gid-with-id vec id-format))
+ ((tramp-get-remote-perl vec) (tramp-get-remote-gid-with-perl vec id-format))
+ ((tramp-get-remote-python vec)
+ (tramp-get-remote-gid-with-python vec id-format)))))
+
(defun tramp-sh-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
;; Modern Unices allow chown only for root. So we might need
@@ -1527,7 +1508,7 @@ of."
(defun tramp-remote-selinux-p (vec)
"Check, whether SELINUX is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p"
+ (with-tramp-connection-property (tramp-get-process vec) "selinux-p"
(tramp-send-command-and-check vec "selinuxenabled")))
(defun tramp-sh-handle-file-selinux-context (filename)
@@ -1535,9 +1516,8 @@ of."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-selinux-context"
(let ((context '(nil nil nil nil))
- (regexp (eval-when-compile
- (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
- "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))))
+ (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):"
+ "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)")))
(when (and (tramp-remote-selinux-p v)
(tramp-send-command-and-check
v (format
@@ -1576,7 +1556,7 @@ of."
(defun tramp-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
+ (with-tramp-connection-property (tramp-get-process vec) "acl-p"
(tramp-send-command-and-check vec "getfacl /")))
(defun tramp-sh-handle-file-acl (filename)
@@ -1706,8 +1686,10 @@ of."
(defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group)
"Like `file-ownership-preserved-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-ownership-preserved-p"
- (let ((attributes (file-attributes filename)))
+ (with-tramp-file-property
+ v localname
+ (format "file-ownership-preserved-p%s" (if group "-group" ""))
+ (let ((attributes (file-attributes filename 'integer)))
;; Return t if the file doesn't exist, since it's true that no
;; information would be lost by an (attempted) delete and create.
(or (null attributes)
@@ -1721,7 +1703,7 @@ of."
;; Directory listings.
(defun tramp-sh-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format _count)
+ (directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(unless (file-exists-p directory)
@@ -1756,13 +1738,18 @@ of."
(setcar item (expand-file-name (car item) directory)))
(push item result)))
- (or (if nosort
- result
- (sort result (lambda (x y) (string< (car x) (car y)))))
+ (unless nosort
+ (setq result (sort result (lambda (x y) (string< (car x) (car y))))))
+
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+
+ (or result
;; The scripts could fail, for example with huge file size.
(tramp-handle-directory-files-and-attributes
- directory full match nosort id-format)))))
+ directory full match nosort id-format count)))))
+;; FIXME: Fix function to work with count parameter.
(defun tramp-do-directory-files-and-attributes-with-perl
(vec localname &optional id-format)
"Implement `directory-files-and-attributes' for Tramp files using a Perl script."
@@ -1778,6 +1765,7 @@ of."
(when (stringp object) (tramp-error vec 'file-error object))
object))
+;; FIXME: Fix function to work with count parameter.
(defun tramp-do-directory-files-and-attributes-with-stat
(vec localname &optional id-format)
"Implement `directory-files-and-attributes' for Tramp files using stat(1) command."
@@ -1785,21 +1773,19 @@ of."
(tramp-send-command-and-read
vec
(format
- (eval-when-compile
- (concat
- ;; We must care about file names with spaces, or starting with
- ;; "-"; this would confuse xargs. "ls -aQ" might be a
- ;; solution, but it does not work on all remote systems.
- ;; Therefore, we use \000 as file separator.
- ;; `tramp-sh--quoting-style-options' do not work for file names
- ;; with spaces piped to "xargs".
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell escape
- ;; of them in file names.
- "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
- "xargs -0 %s -c "
- "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
- "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\""))
+ (concat
+ ;; We must care about file names with spaces, or starting with
+ ;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
+ ;; but it does not work on all remote systems. Therefore, we use
+ ;; \000 as file separator. `tramp-sh--quoting-style-options' do
+ ;; not work for file names with spaces piped to "xargs".
+ ;; Apostrophes in the stat output are masked as
+ ;; `tramp-stat-marker', in order to make a proper shell escape of
+ ;; them in file names.
+ "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
+ "xargs -0 %s -c "
+ "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
+ "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
;; On systems which have no quoting style, file names with special
@@ -1840,13 +1826,12 @@ of."
(format "tramp_perl_file_name_all_completions %s"
(tramp-shell-quote-argument localname)))
- (format (eval-when-compile
- (concat
- "(cd %s 2>&1 && %s -a 2>/dev/null"
- " | while IFS= read f; do"
- " if %s -d \"$f\" 2>/dev/null;"
- " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
- " && \\echo ok) || \\echo fail"))
+ (format (concat
+ "(cd %s 2>&1 && %s -a 2>/dev/null"
+ " | while IFS= read f; do"
+ " if %s -d \"$f\" 2>/dev/null;"
+ " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
+ " && \\echo ok) || \\echo fail")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command v)
(tramp-get-test-command v))))
@@ -1954,7 +1939,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
;; scp or rsync DTRT.
(progn
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(setq dirname (directory-file-name (expand-file-name dirname))
newname (directory-file-name (expand-file-name newname)))
@@ -1967,7 +1952,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(unless (file-directory-p (file-name-directory newname))
(make-directory (file-name-directory newname) parents))
(tramp-do-copy-or-rename-file-out-of-band
- 'copy dirname newname keep-date))
+ 'copy dirname newname 'ok-if-already-exists keep-date))
;; We must do it file-wise.
(tramp-run-real-handler
@@ -1984,8 +1969,8 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
"Like `rename-file' for Tramp files."
;; Check if both files are local -- invoke normal rename-file.
;; Otherwise, use Tramp from local system.
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -2036,7 +2021,7 @@ file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -2063,7 +2048,7 @@ file names."
(tramp-method-out-of-band-p v1 length)
(tramp-method-out-of-band-p v2 length))
(tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
+ op filename newname ok-if-already-exists keep-date))
;; No shortcut was possible. So we copy the file
;; first. If the operation was `rename', we go back
@@ -2076,7 +2061,7 @@ file names."
;; source and target file.
(t
(tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))))
+ op filename newname ok-if-already-exists keep-date))))))
;; One file is a Tramp file, the other one is local.
((or t1 t2)
@@ -2091,11 +2076,11 @@ file names."
;; corresponding copy-program can be invoked.
((tramp-method-out-of-band-p v length)
(tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
+ op filename newname ok-if-already-exists keep-date))
;; Use the inline method via a Tramp buffer.
(t (tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))
+ op filename newname ok-if-already-exists keep-date))))
(t
;; One of them must be a Tramp file.
@@ -2117,7 +2102,8 @@ file names."
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname))))))))
-(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
+(defun tramp-do-copy-or-rename-file-via-buffer
+ (op filename newname ok-if-already-exists keep-date)
"Use an Emacs buffer to copy or rename a file.
First arg OP is either `copy' or `rename' and indicates the operation.
FILENAME is the source file, NEWNAME the target file.
@@ -2145,10 +2131,11 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
(insert-file-contents-literally filename)))
;; KEEP-DATE handling.
(when keep-date
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(set-file-modes newname (tramp-default-file-modes filename))
;; If the operation was `rename', delete the original file.
@@ -2302,10 +2289,12 @@ the uid and gid from FILENAME."
;; Set the time and mode. Mask possible errors.
(ignore-errors
(when keep-date
- (set-file-times newname file-times)
+ (tramp-compat-set-file-times
+ newname file-times (unless ok-if-already-exists 'nofollow))
(set-file-modes newname file-modes))))))
-(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
+(defun tramp-do-copy-or-rename-file-out-of-band
+ (op filename newname ok-if-already-exists keep-date)
"Invoke `scp' program to copy.
The method used must be an out-of-band method."
(let* ((t1 (tramp-tramp-file-p filename))
@@ -2328,9 +2317,9 @@ The method used must be an out-of-band method."
(unwind-protect
(progn
(tramp-do-copy-or-rename-file-out-of-band
- op filename tmpfile keep-date)
+ op filename tmpfile ok-if-already-exists keep-date)
(tramp-do-copy-or-rename-file-out-of-band
- 'rename tmpfile newname keep-date))
+ 'rename tmpfile newname ok-if-already-exists keep-date))
;; Save exit.
(ignore-errors
(if dir-flag
@@ -2504,10 +2493,11 @@ The method used must be an out-of-band method."
;; Handle KEEP-DATE argument.
(when (and keep-date (not copy-keep-date))
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(unless (and keep-date copy-keep-date)
@@ -2539,13 +2529,10 @@ The method used must be an out-of-band method."
(defun tramp-sh-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
- (setq directory (expand-file-name directory))
- (with-parsed-tramp-file-name directory nil
- (tramp-flush-directory-properties v localname)
+ (tramp-skeleton-delete-directory directory recursive trash
(tramp-barf-unless-okay
v (format "cd / && %s %s"
- (or (and trash (tramp-get-remote-trash v))
- (if recursive "rm -rf" "rmdir"))
+ (if recursive "rm -rf" "rmdir")
(tramp-shell-quote-argument localname))
"Couldn't delete %s" directory)))
@@ -2554,11 +2541,11 @@ The method used must be an out-of-band method."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
- (tramp-barf-unless-okay
- v (format "%s %s"
- (or (and trash (tramp-get-remote-trash v)) "rm -f")
- (tramp-shell-quote-argument localname))
- "Couldn't delete %s" filename)))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash filename)
+ (tramp-barf-unless-okay
+ v (format "rm -f %s" (tramp-shell-quote-argument localname))
+ "Couldn't delete %s" filename))))
;; Dired.
@@ -2720,7 +2707,7 @@ The method used must be an out-of-band method."
(when (file-symlink-p filename)
(goto-char (search-backward "->" beg 'noerror)))
(search-backward
- (if (tramp-compat-directory-name-p filename)
+ (if (directory-name-p filename)
"."
(file-name-nondirectory filename))
beg 'noerror)
@@ -2730,12 +2717,11 @@ The method used must be an out-of-band method."
(goto-char (point-min))
;; First find the line to put it on.
(when (re-search-forward "^\\([[:space:]]*total\\)" nil t)
- (let ((available (get-free-disk-space ".")))
- (when available
- ;; Replace "total" with "total used", to avoid confusion.
- (replace-match "\\1 used in directory")
- (end-of-line)
- (insert " available " available))))
+ (when-let ((available (get-free-disk-space ".")))
+ ;; Replace "total" with "total used", to avoid confusion.
+ (replace-match "\\1 used in directory")
+ (end-of-line)
+ (insert " available " available)))
(goto-char (point-max)))))))
@@ -2806,225 +2792,234 @@ the result will be a local, non-Tramp, file name."
;; terminated.
(defun tramp-sh-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
-STDERR can also be a file name."
- (when args
- (with-parsed-tramp-file-name (expand-file-name default-directory) nil
- (let ((name (plist-get args :name))
- (buffer (plist-get args :buffer))
- (command (plist-get args :command))
- (coding (plist-get args :coding))
- (noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
- (filter (plist-get args :filter))
- (sentinel (plist-get args :sentinel))
- (stderr (plist-get args :stderr)))
- (unless (stringp name)
- (signal 'wrong-type-argument (list #'stringp name)))
- (unless (or (null buffer) (bufferp buffer) (stringp buffer))
- (signal 'wrong-type-argument (list #'stringp buffer)))
- (unless (or (null command) (consp command))
- (signal 'wrong-type-argument (list #'consp command)))
- (unless (or (null coding)
- (and (symbolp coding) (memq coding coding-system-list))
- (and (consp coding)
- (memq (car coding) coding-system-list)
- (memq (cdr coding) coding-system-list)))
- (signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
- (signal 'wrong-type-argument (list #'symbolp connection-type)))
- (unless (or (null filter) (functionp filter))
- (signal 'wrong-type-argument (list #'functionp filter)))
- (unless (or (null sentinel) (functionp sentinel))
- (signal 'wrong-type-argument (list #'functionp sentinel)))
- (unless (or (null stderr) (bufferp stderr) (stringp stderr))
- (signal 'wrong-type-argument (list #'stringp stderr)))
- (when (and (stringp stderr) (tramp-tramp-file-p stderr)
- (not (tramp-equal-remote default-directory stderr)))
- (signal 'file-error (list "Wrong stderr" stderr)))
-
- (let* ((buffer
- (if buffer
- (get-buffer-create buffer)
- ;; BUFFER can be nil. We use a temporary buffer.
- (generate-new-buffer tramp-temp-buffer-name)))
- ;; STDERR can also be a file name.
- (tmpstderr
- (and stderr
- (if (and (stringp stderr) (tramp-tramp-file-p stderr))
- (tramp-unquote-file-local-name stderr)
- (tramp-make-tramp-temp-file v))))
- (remote-tmpstderr
- (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
- (program (car command))
- (args (cdr command))
- ;; When PROGRAM matches "*sh", and the first arg is
- ;; "-c", it might be that the arguments exceed the
- ;; command line length. Therefore, we modify the
- ;; command.
- (heredoc (and (stringp program)
- (string-match-p "sh$" program)
- (= (length args) 2)
- (string-equal "-c" (car args))
- ;; Don't if there is a string.
- (not (string-match-p "'\\|\"" (cadr args)))))
- ;; When PROGRAM is nil, we just provide a tty.
- (args (if (not heredoc) args
- (let ((i 250))
- (while (and (< i (length (cadr args)))
- (string-match " " (cadr args) i))
- (setcdr
- args
- (list
- (replace-match " \\\\\n" nil nil (cadr args))))
- (setq i (+ i 250))))
- (cdr args)))
- ;; Use a human-friendly prompt, for example for
- ;; `shell'. We discard hops, if existing, that's why
- ;; we cannot use `file-remote-p'.
- (prompt (format "PS1=%s %s"
- (tramp-make-tramp-file-name v nil 'nohop)
- tramp-initial-end-of-output))
- ;; We use as environment the difference to toplevel
- ;; `process-environment'.
- env uenv
- (env (dolist (elt (cons prompt process-environment) env)
- (or (member
- elt (default-toplevel-value 'process-environment))
- (if (string-match-p "=" elt)
- (setq env (append env `(,elt)))
- (if (tramp-get-env-with-u-option v)
- (setq env (append `("-u" ,elt) env))
- (setq uenv (cons elt uenv)))))))
- (command
- (when (stringp program)
- (format "cd %s && %s exec %s %s env %s %s"
- (tramp-shell-quote-argument localname)
- (if uenv
- (format
- "unset %s &&"
- (mapconcat
- #'tramp-shell-quote-argument uenv " "))
- "")
- (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
- (if tmpstderr (format "2>'%s'" tmpstderr) "")
- (mapconcat #'tramp-shell-quote-argument env " ")
- (if heredoc
- (format "%s\n(\n%s\n) </dev/tty\n%s"
- program (car args) tramp-end-of-heredoc)
- (mapconcat #'tramp-shell-quote-argument
- (cons program args) " ")))))
- (tramp-process-connection-type
- (or (null program) tramp-process-connection-type))
- (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
- (name1 name)
- (i 0)
- ;; We do not want to raise an error when `make-process'
- ;; has been started several times in `eshell' and
- ;; friends.
- tramp-current-connection
- p)
-
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- (setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
-
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise, `make-process' could
- ;; be called on the local host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save BUFFER
- ;; contents. Clear also the modification time;
- ;; otherwise we might be interrupted by
- ;; `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (mark (point-max)))
- (clear-visited-file-modtime)
- (narrow-to-region (point-max) (point-max))
- ;; We call `tramp-maybe-open-connection', in
- ;; order to cleanup the prompt afterwards.
- (catch 'suppress
- (tramp-maybe-open-connection v)
- (setq p (tramp-get-connection-process v))
- ;; Set the pid of the remote shell. This is
- ;; needed when sending signals remotely.
- (let ((pid (tramp-send-command-and-read v "echo $$")))
- (process-put p 'remote-pid pid)
- (tramp-set-connection-property p "remote-pid" pid))
- ;; `tramp-maybe-open-connection' and
- ;; `tramp-send-command-and-read' could have
- ;; trashed the connection buffer. Remove this.
- (widen)
- (delete-region mark (point-max))
+STDERR can also be a file name. If connection property
+\"direct-async-process\" is non-nil, an alternative
+implementation will be used."
+ (if (tramp-direct-async-process-p args)
+ (apply #'tramp-handle-make-process args)
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((name (plist-get args :name))
+ (buffer (plist-get args :buffer))
+ (command (plist-get args :command))
+ (coding (plist-get args :coding))
+ (noquery (plist-get args :noquery))
+ (connection-type (plist-get args :connection-type))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ (stderr (plist-get args :stderr)))
+ (unless (stringp name)
+ (signal 'wrong-type-argument (list #'stringp name)))
+ (unless (or (null buffer) (bufferp buffer) (stringp buffer))
+ (signal 'wrong-type-argument (list #'stringp buffer)))
+ (unless (or (null command) (consp command))
+ (signal 'wrong-type-argument (list #'consp command)))
+ (unless (or (null coding)
+ (and (symbolp coding) (memq coding coding-system-list))
+ (and (consp coding)
+ (memq (car coding) coding-system-list)
+ (memq (cdr coding) coding-system-list)))
+ (signal 'wrong-type-argument (list #'symbolp coding)))
+ (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (functionp filter))
+ (signal 'wrong-type-argument (list #'functionp filter)))
+ (unless (or (null sentinel) (functionp sentinel))
+ (signal 'wrong-type-argument (list #'functionp sentinel)))
+ (unless (or (null stderr) (bufferp stderr) (stringp stderr))
+ (signal 'wrong-type-argument (list #'stringp stderr)))
+ (when (and (stringp stderr) (tramp-tramp-file-p stderr)
+ (not (tramp-equal-remote default-directory stderr)))
+ (signal 'file-error (list "Wrong stderr" stderr)))
+
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ ;; STDERR can also be a file name.
+ (tmpstderr
+ (and stderr
+ (if (and (stringp stderr) (tramp-tramp-file-p stderr))
+ (tramp-unquote-file-local-name stderr)
+ (tramp-make-tramp-temp-file v))))
+ (remote-tmpstderr
+ (and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (program (car command))
+ (args (cdr command))
+ ;; When PROGRAM matches "*sh", and the first arg is
+ ;; "-c", it might be that the arguments exceed the
+ ;; command line length. Therefore, we modify the
+ ;; command.
+ (heredoc (and (stringp program)
+ (string-match-p "sh$" program)
+ (= (length args) 2)
+ (string-equal "-c" (car args))
+ ;; Don't if there is a string.
+ (not (string-match-p "'\\|\"" (cadr args)))))
+ ;; When PROGRAM is nil, we just provide a tty.
+ (args (if (not heredoc) args
+ (let ((i 250))
+ (while (and (< i (length (cadr args)))
+ (string-match " " (cadr args) i))
+ (setcdr
+ args
+ (list
+ (replace-match " \\\\\n" nil nil (cadr args))))
+ (setq i (+ i 250))))
+ (cdr args)))
+ ;; Use a human-friendly prompt, for example for
+ ;; `shell'. We discard hops, if existing, that's why
+ ;; we cannot use `file-remote-p'.
+ (prompt (format "PS1=%s %s"
+ (tramp-make-tramp-file-name v nil 'nohop)
+ tramp-initial-end-of-output))
+ ;; We use as environment the difference to toplevel
+ ;; `process-environment'.
+ env uenv
+ (env (dolist (elt (cons prompt process-environment) env)
+ (or (member
+ elt (default-toplevel-value 'process-environment))
+ (if (string-match-p "=" elt)
+ (setq env (append env `(,elt)))
+ (if (tramp-get-env-with-u-option v)
+ (setq env (append `("-u" ,elt) env))
+ (setq uenv (cons elt uenv)))))))
+ (command
+ (when (stringp program)
+ (setenv-internal
+ env "INSIDE_EMACS"
+ (concat (or (getenv "INSIDE_EMACS") emacs-version)
+ ",tramp:" tramp-version)
+ 'keep)
+ (format "cd %s && %s exec %s %s env %s %s"
+ (tramp-shell-quote-argument localname)
+ (if uenv
+ (format
+ "unset %s &&"
+ (mapconcat
+ #'tramp-shell-quote-argument uenv " "))
+ "")
+ (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
+ (if tmpstderr (format "2>'%s'" tmpstderr) "")
+ (mapconcat #'tramp-shell-quote-argument env " ")
+ (if heredoc
+ (format "%s\n(\n%s\n) </dev/tty\n%s"
+ program (car args) tramp-end-of-heredoc)
+ (mapconcat #'tramp-shell-quote-argument
+ (cons program args) " ")))))
+ (tramp-process-connection-type
+ (or (null program) tramp-process-connection-type))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0)
+ ;; We do not want to raise an error when
+ ;; `make-process' has been started several times in
+ ;; `eshell' and friends.
+ tramp-current-connection
+ p)
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process'
+ ;; could be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification time;
+ ;; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (mark (point-max)))
+ (clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
- ;; Now do it.
- (if command
- ;; Send the command.
- (tramp-send-command v command nil t) ; nooutput
- ;; Check, whether a pty is associated.
- (unless (process-get p 'remote-tty)
- (tramp-error
- v 'file-error
- "pty association is not supported for `%s'"
- name))))
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- ;; Set query flag and process marker for this
- ;; process. We ignore errors, because the
- ;; process could have finished already.
- (ignore-errors
- (set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point)))
- ;; We must flush them here already; otherwise
- ;; `rename-file', `delete-file' or
- ;; `insert-file-contents' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Copy tmpstderr file.
- (when (and (stringp stderr)
- (not (tramp-tramp-file-p stderr)))
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (rename-file remote-tmpstderr stderr))))
- ;; Provide error buffer. This shows only
- ;; initial error messages; messages arriving
- ;; later on will be inserted when the process is
- ;; deleted. The temporary file will exist until
- ;; the process is deleted.
- (when (bufferp stderr)
- (with-current-buffer stderr
- (insert-file-contents-literally remote-tmpstderr))
- ;; Delete tmpstderr file.
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (when (file-exists-p remote-tmpstderr)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr nil nil nil 'replace))
- (delete-file remote-tmpstderr)))))
- ;; Return process.
- p)))
+ ;; We call `tramp-maybe-open-connection', in
+ ;; order to cleanup the prompt afterwards.
+ (catch 'suppress
+ (tramp-maybe-open-connection v)
+ (setq p (tramp-get-connection-process v))
+ ;; Set the pid of the remote shell. This is
+ ;; needed when sending signals remotely.
+ (let ((pid (tramp-send-command-and-read v "echo $$")))
+ (process-put p 'remote-pid pid)
+ (tramp-set-connection-property p "remote-pid" pid))
+ ;; `tramp-maybe-open-connection' and
+ ;; `tramp-send-command-and-read' could have
+ ;; trashed the connection buffer. Remove this.
+ (widen)
+ (delete-region mark (point-max))
+ (narrow-to-region (point-max) (point-max))
+ ;; Now do it.
+ (if command
+ ;; Send the command.
+ (tramp-send-command v command nil t) ; nooutput
+ ;; Check, whether a pty is associated.
+ (unless (process-get p 'remote-tty)
+ (tramp-error
+ v 'file-error
+ "pty association is not supported for `%s'"
+ name))))
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ ;; Set query flag and process marker for this
+ ;; process. We ignore errors, because the
+ ;; process could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (null noquery))
+ (set-marker (process-mark p) (point)))
+ ;; We must flush them here already; otherwise
+ ;; `rename-file', `delete-file' or
+ ;; `insert-file-contents' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ ;; Copy tmpstderr file.
+ (when (and (stringp stderr)
+ (not (tramp-tramp-file-p stderr)))
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (rename-file remote-tmpstderr stderr))))
+ ;; Provide error buffer. This shows only
+ ;; initial error messages; messages arriving
+ ;; later on will be inserted when the process
+ ;; is deleted. The temporary file will exist
+ ;; until the process is deleted.
+ (when (bufferp stderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally remote-tmpstderr))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (when (file-exists-p remote-tmpstderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr nil nil nil 'replace))
+ (delete-file remote-tmpstderr)))))
+ ;; Return process.
+ p)))
- ;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer p nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer"))))))))
+ ;; Save exit.
+ (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp))
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")))))))))
(defun tramp-sh-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
@@ -3105,6 +3100,11 @@ STDERR can also be a file name."
(if (tramp-get-env-with-u-option v)
(setq env (append `("-u" ,elt) env))
(setq uenv (cons elt uenv))))))
+ (setenv-internal
+ env "INSIDE_EMACS"
+ (concat (or (getenv "INSIDE_EMACS") emacs-version)
+ ",tramp:" tramp-version)
+ 'keep)
(when env
(setq command
(format
@@ -3333,7 +3333,8 @@ STDERR can also be a file name."
#'write-region
(list start end localname append 'no-message lockname))
- (let* ((modes (save-excursion (tramp-default-file-modes filename)))
+ (let* ((modes (tramp-default-file-modes
+ filename (and (eq mustbenew 'excl) 'nofollow)))
;; We use this to save the value of
;; `last-coding-system-used' after writing the tmp
;; file. At the end of the function, we set
@@ -3452,9 +3453,8 @@ STDERR can also be a file name."
loc-enc tmpfile t))
(tramp-error
v 'file-error
- (eval-when-compile
- (concat "Cannot write to `%s', "
- "local encoding command `%s' failed"))
+ (concat "Cannot write to `%s', "
+ "local encoding command `%s' failed")
filename loc-enc))))
;; Send buffer into remote decoding command which
@@ -3499,9 +3499,8 @@ STDERR can also be a file name."
(buffer-string))))
(tramp-error
v 'file-error
- (eval-when-compile
- (concat "Couldn't write region to `%s',"
- " decode using `%s' failed"))
+ (concat "Couldn't write region to `%s',"
+ " decode using `%s' failed")
filename rem-dec)))))
;; Save exit.
@@ -3511,9 +3510,8 @@ STDERR can also be a file name."
(t
(tramp-error
v 'file-error
- (eval-when-compile
- (concat "Method `%s' should specify both encoding and "
- "decoding command or an scp program"))
+ (concat "Method `%s' should specify both encoding and "
+ "decoding command or an scp program")
method))))
;; Make `last-coding-system-used' have the right value.
@@ -3532,7 +3530,8 @@ STDERR can also be a file name."
;; We must pass modtime explicitly, because FILENAME can
;; be different from (buffer-file-name), f.e. if
;; `file-precious-flag' is set.
- (tramp-compat-file-attribute-modification-time file-attr))
+ (or (tramp-compat-file-attribute-modification-time file-attr)
+ (current-time)))
(when (and (= (tramp-compat-file-attribute-user-id file-attr) uid)
(= (tramp-compat-file-attribute-group-id file-attr) gid))
(setq need-chown nil))))
@@ -3566,8 +3565,7 @@ STDERR can also be a file name."
(defun tramp-sh-handle-vc-registered (file)
"Like `vc-registered' for Tramp files."
(when vc-handled-backends
- (let ((tramp-message-show-message
- (and (not revert-buffer-in-progress-p) tramp-message-show-message))
+ (let ((inhibit-message (or revert-buffer-in-progress-p inhibit-message))
(temp-message (unless revert-buffer-in-progress-p "")))
(with-temp-message temp-message
(with-parsed-tramp-file-name file nil
@@ -3626,27 +3624,30 @@ STDERR can also be a file name."
;; calls shall be answered from the file cache. We unset
;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
;; in order to keep the cache.
- (let ((vc-handled-backends vc-handled-backends)
+ (let ((vc-handled-backends (copy-sequence vc-handled-backends))
remote-file-name-inhibit-cache process-file-side-effects)
;; Reduce `vc-handled-backends' in order to minimize
;; process calls.
- (when (and (memq 'Bzr vc-handled-backends)
- (boundp 'vc-bzr-program)
+ (when (and
+ (memq 'Bzr vc-handled-backends)
+ (or (not (require 'vc-bzr nil 'noerror))
(not (with-tramp-connection-property v vc-bzr-program
(tramp-find-executable
- v vc-bzr-program (tramp-get-remote-path v)))))
+ v vc-bzr-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
- (when (and (memq 'Git vc-handled-backends)
- (boundp 'vc-git-program)
+ (when (and
+ (memq 'Git vc-handled-backends)
+ (or (not (require 'vc-git nil 'noerror))
(not (with-tramp-connection-property v vc-git-program
(tramp-find-executable
- v vc-git-program (tramp-get-remote-path v)))))
+ v vc-git-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Git vc-handled-backends)))
- (when (and (memq 'Hg vc-handled-backends)
- (boundp 'vc-hg-program)
+ (when (and
+ (memq 'Hg vc-handled-backends)
+ (or (not (require 'vc-hg nil 'noerror))
(not (with-tramp-connection-property v vc-hg-program
(tramp-find-executable
- v vc-hg-program (tramp-get-remote-path v)))))
+ v vc-hg-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Hg vc-handled-backends)))
;; Run.
(tramp-with-demoted-errors
@@ -3657,10 +3658,17 @@ STDERR can also be a file name."
(defun tramp-sh-file-name-handler (operation &rest args)
"Invoke remote-shell Tramp file name handler.
Fall back to normal file name handler if no Tramp handler exists."
- (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
+
+;;;###tramp-autoload
+(defun tramp-sh-file-name-handler-p (vec)
+ "Whether VEC uses a method from `tramp-sh-file-name-handler'."
+ (and (assoc (tramp-file-name-method vec) tramp-methods)
+ (eq (tramp-find-foreign-file-name-handler
+ (tramp-make-tramp-file-name vec nil 'nohop))
+ 'tramp-sh-file-name-handler)))
;; This must be the last entry, because `identity' always matches.
;;;###tramp-autoload
@@ -3712,13 +3720,11 @@ Fall back to normal file name handler if no Tramp handler exists."
events
(cond
((and (memq 'change flags) (memq 'attribute-change flags))
- (eval-when-compile
- (concat "create,modify,move,moved_from,moved_to,move_self,"
- "delete,delete_self,attrib,ignored")))
+ (concat "create,modify,move,moved_from,moved_to,move_self,"
+ "delete,delete_self,attrib,ignored"))
((memq 'change flags)
- (eval-when-compile
- (concat "create,modify,move,moved_from,moved_to,move_self,"
- "delete,delete_self,ignored")))
+ (concat "create,modify,move,moved_from,moved_to,move_self,"
+ "delete,delete_self,ignored"))
((memq 'attribute-change flags) "attrib,ignored"))
sequence `(,command "-mq" "-e" ,events ,localname)
;; Make events a list of symbols.
@@ -3860,12 +3866,11 @@ Fall back to normal file name handler if no Tramp handler exists."
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
(while (string-match
- (eval-when-compile
- (concat "^[\n\r]*"
- "Directory Monitor Event:[\n\r]+"
- "Child = \\([^\n\r]+\\)[\n\r]+"
- "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?"
- "Event = \\([^[:blank:]]+\\)[\n\r]+"))
+ (concat "^[\n\r]*"
+ "Directory Monitor Event:[\n\r]+"
+ "Child = \\([^\n\r]+\\)[\n\r]+"
+ "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?"
+ "Event = \\([^[:blank:]]+\\)[\n\r]+")
string)
(let* ((file (match-string 1 string))
(file1 (match-string 3 string))
@@ -3901,10 +3906,9 @@ Fall back to normal file name handler if no Tramp handler exists."
(dolist (line (split-string string "[\n\r]+" 'omit))
;; Check, whether there is a problem.
(unless (string-match
- (eval-when-compile
- (concat "^[^[:blank:]]+"
- "[[:blank:]]+\\([^[:blank:]]+\\)"
- "\\([[:blank:]]+\\([^\n\r]+\\)\\)?"))
+ (concat "^[^[:blank:]]+"
+ "[[:blank:]]+\\([^[:blank:]]+\\)"
+ "\\([[:blank:]]+\\([^\n\r]+\\)\\)?")
line)
(tramp-error proc 'file-notify-error "%s" line))
@@ -3940,11 +3944,10 @@ Fall back to normal file name handler if no Tramp handler exists."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?"
- "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
+ (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?"
+ "[[:space:]]*\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"))
(mapcar
(lambda (d)
(* d (tramp-get-connection-property v "df-blocksize" 0)))
@@ -4013,13 +4016,16 @@ hosts, or files, disagree."
(tramp-shell-quote-argument v1-localname)
(tramp-shell-quote-argument v2-localname))))))
+(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
+ "Regexp to determine remote SunOS.")
+
(defun tramp-find-executable
(vec progname dirlist &optional ignore-tilde ignore-path)
"Search for PROGNAME in $PATH and all directories mentioned in DIRLIST.
First arg VEC specifies the connection, PROGNAME is the program
to search for, and DIRLIST gives the list of directories to
search. If IGNORE-TILDE is non-nil, directory names starting
-with `~' will be ignored. If IGNORE-PATH is non-nil, searches
+with \"~\" will be ignored. If IGNORE-PATH is non-nil, searches
only in DIRLIST.
Returns the absolute file name of PROGNAME, if found, and nil otherwise.
@@ -4034,7 +4040,7 @@ This function expects to be in the right *tramp* buffer."
;; therefore.
(unless (or ignore-path
(string-match-p
- (eval-when-compile (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
+ tramp-sunos-unames
(tramp-get-connection-property vec "uname" "")))
(tramp-send-command vec (format "which \\%s | wc -w" progname))
(goto-char (point-min))
@@ -4045,19 +4051,18 @@ This function expects to be in the right *tramp* buffer."
;; Remove all ~/foo directories from dirlist.
(let (newdl d)
(while dirlist
- (setq d (car dirlist))
- (setq dirlist (cdr dirlist))
+ (setq d (car dirlist)
+ dirlist (cdr dirlist))
(unless (char-equal ?~ (aref d 0))
(setq newdl (cons d newdl))))
(setq dirlist (nreverse newdl))))
(tramp-send-command
vec
- (format (eval-when-compile
- (concat "while read d; "
- "do if test -x $d/%s && test -f $d/%s; "
- "then echo tramp_executable $d/%s; "
- "break; fi; done <<'%s'\n"
- "%s\n%s"))
+ (format (concat "while read d; "
+ "do if test -x $d/%s && test -f $d/%s; "
+ "then echo tramp_executable $d/%s; "
+ "break; fi; done <<'%s'\n"
+ "%s\n%s")
progname progname progname
tramp-end-of-heredoc
(string-join dirlist "\n")
@@ -4098,7 +4103,7 @@ variable PATH."
chunk (substring command 0 chunksize)
command (substring command chunksize))
(tramp-send-command vec (format
- "echo -n %s >>%s"
+ "printf \"%%b\" \"$*\" %s >>%s"
(tramp-shell-quote-argument chunk)
(tramp-shell-quote-argument tmpfile))))
(tramp-send-command vec (format ". %s" tmpfile))
@@ -4195,12 +4200,11 @@ file exists and nonzero exit status otherwise."
;; our initial probes to ensure the remote shell is usable.)
(tramp-send-command
vec (format
- (eval-when-compile
- (concat
- "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
- "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"))
+ (concat
+ "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
+ "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s")
tramp-terminal-type
- emacs-version tramp-version ; INSIDE_EMACS
+ (or (getenv "INSIDE_EMACS") emacs-version) tramp-version
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
(if (stringp tramp-histfile-override)
(format "HISTFILE=%s"
@@ -4228,45 +4232,45 @@ file exists and nonzero exit status otherwise."
(defun tramp-find-shell (vec)
"Open a shell on the remote host which groks tilde expansion."
- (with-current-buffer (tramp-get-buffer vec)
- (let ((default-shell (tramp-get-method-parameter vec 'tramp-remote-shell))
- shell)
- (setq shell
- (with-tramp-connection-property vec "remote-shell"
- ;; CCC: "root" does not exist always, see my QNAP TS-459.
- ;; Which check could we apply instead?
- (tramp-send-command vec "echo ~root" t)
- (if (or (string-match-p "^~root$" (buffer-string))
- ;; The default shell (ksh93) of OpenSolaris and
- ;; Solaris is buggy. We've got reports for
- ;; "SunOS 5.10" and "SunOS 5.11" so far.
- (string-match-p
- (eval-when-compile
- (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
- (tramp-get-connection-property vec "uname" "")))
-
- (or (tramp-find-executable
- vec "bash" (tramp-get-remote-path vec) t t)
- (tramp-find-executable
- vec "ksh" (tramp-get-remote-path vec) t t)
- ;; Maybe it works at least for some other commands.
- (prog1
- default-shell
- (tramp-message
- vec 2
- (eval-when-compile
+ ;; If we are in `make-process', we don't need another shell.
+ (unless (tramp-get-connection-property vec "process-name" nil)
+ (with-current-buffer (tramp-get-buffer vec)
+ (let ((default-shell (tramp-get-method-parameter vec 'tramp-remote-shell))
+ shell)
+ (setq shell
+ (with-tramp-connection-property vec "remote-shell"
+ ;; CCC: "root" does not exist always, see my QNAP
+ ;; TS-459. Which check could we apply instead?
+ (tramp-send-command vec "echo ~root" t)
+ (if (or (string-match-p "^~root$" (buffer-string))
+ ;; The default shell (ksh93) of OpenSolaris
+ ;; and Solaris is buggy. We've got reports
+ ;; for "SunOS 5.10" and "SunOS 5.11" so far.
+ (string-match-p
+ tramp-sunos-unames
+ (tramp-get-connection-property vec "uname" "")))
+
+ (or (tramp-find-executable
+ vec "bash" (tramp-get-remote-path vec) t t)
+ (tramp-find-executable
+ vec "ksh" (tramp-get-remote-path vec) t t)
+ ;; Maybe it works at least for some other commands.
+ (prog1
+ default-shell
+ (tramp-message
+ vec 2
(concat
"Couldn't find a remote shell which groks tilde "
- "expansion, using `%s'"))
- default-shell)))
+ "expansion, using `%s'")
+ default-shell)))
- default-shell)))
+ default-shell)))
- ;; Open a new shell if needed.
- (unless (string-equal shell default-shell)
- (tramp-message
- vec 5 "Starting remote shell `%s' for tilde expansion" shell)
- (tramp-open-shell vec shell)))))
+ ;; Open a new shell if needed.
+ (unless (string-equal shell default-shell)
+ (tramp-message
+ vec 5 "Starting remote shell `%s' for tilde expansion" shell)
+ (tramp-open-shell vec shell))))))
;; Utility functions.
@@ -4328,11 +4332,15 @@ process to set up. VEC specifies the connection."
;; connection properties. We start again with
;; `tramp-maybe-open-connection', it will be caught there.
(tramp-message vec 5 "Checking system information")
- (let ((old-uname (tramp-get-connection-property vec "uname" nil))
- (uname
- (tramp-set-connection-property
- vec "uname"
- (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
+ (let* ((old-uname (tramp-get-connection-property vec "uname" nil))
+ (uname
+ ;; If we are in `make-process', we don't need to recompute.
+ (if (and old-uname
+ (tramp-get-connection-property vec "process-name" nil))
+ old-uname
+ (tramp-set-connection-property
+ vec "uname"
+ (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))))
(when (and (stringp old-uname) (not (string-equal old-uname uname)))
(tramp-message
vec 3
@@ -4384,7 +4392,7 @@ process to set up. VEC specifies the connection."
(t
(tramp-message
vec 5 "Checking remote host type for `send-process-string' bug")
- (if (string-match-p "^FreeBSD" uname) 500 0))))
+ (if (string-match-p "FreeBSD\\|DragonFly" uname) 500 0))))
;; Set remote PATH variable.
(tramp-set-remote-path vec)
@@ -4406,12 +4414,12 @@ process to set up. VEC specifies the connection."
;; IRIX64 bash expands "!" even when in single quotes. This
;; destroys our shell functions, we must disable it. See
- ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
+ ;; <https://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
(when (string-match-p "^IRIX64" uname)
(tramp-send-command vec "set +H" t))
;; Disable tab expansion.
- (if (string-match-p "BSD\\|Darwin" uname)
+ (if (string-match-p "BSD\\|DragonFly\\|Darwin" uname)
(tramp-send-command vec "stty tabs" t)
(tramp-send-command vec "stty tab0" t))
@@ -4552,8 +4560,8 @@ Goes through the list `tramp-local-coding-commands' and
(catch 'wont-work-local
(let ((format (nth 0 litem))
(remote-commands tramp-remote-coding-commands))
- (setq loc-enc (nth 1 litem))
- (setq loc-dec (nth 2 litem))
+ (setq loc-enc (nth 1 litem)
+ loc-dec (nth 2 litem))
;; If the local encoder or decoder is a string, the
;; corresponding command has to work locally.
(if (not (stringp loc-enc))
@@ -4575,9 +4583,9 @@ Goes through the list `tramp-local-coding-commands' and
(setq ritem (pop remote-commands))
(catch 'wont-work-remote
(when (equal format (nth 0 ritem))
- (setq rem-enc (nth 1 ritem))
- (setq rem-dec (nth 2 ritem))
- (setq rem-test (nth 3 ritem))
+ (setq rem-enc (nth 1 ritem)
+ rem-dec (nth 2 ritem)
+ rem-test (nth 3 ritem))
;; Check the remote test command if exists.
(when (stringp rem-test)
(tramp-message
@@ -4647,11 +4655,7 @@ Goes through the list `tramp-local-coding-commands' and
?o (tramp-get-remote-od vec)))
value (replace-regexp-in-string "%" "%%" value)))
(when (string-match-p "\\(^\\|[^%]\\)%t" value)
- (setq tmpfile
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-get-remote-tmpdir vec)))
+ (setq tmpfile (tramp-make-tramp-temp-name vec)
value
(format-spec
value
@@ -4674,9 +4678,9 @@ Goes through the list `tramp-local-coding-commands' and
(throw 'wont-work-remote nil)))
;; `rem-enc' and `rem-dec' could be a string meanwhile.
- (setq rem-enc (nth 1 ritem))
- (setq rem-dec (nth 2 ritem))
- (setq found t)))))))
+ (setq rem-enc (nth 1 ritem)
+ rem-dec (nth 2 ritem)
+ found t)))))))
(when found
;; Set connection properties. Since the commands are risky
@@ -4789,99 +4793,6 @@ Goes through the list `tramp-inline-compress-commands'."
(tramp-message
vec 2 "Couldn't find an inline transfer compress command")))))
-(defun tramp-compute-multi-hops (vec)
- "Expands VEC according to `tramp-default-proxies-alist'."
- (let ((saved-tdpa tramp-default-proxies-alist)
- (target-alist `(,vec))
- (hops (or (tramp-file-name-hop vec) ""))
- (item vec)
- choices proxy)
-
- ;; Ad-hoc proxy definitions.
- (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
- (let* ((host-port (tramp-file-name-host-port item))
- (user-domain (tramp-file-name-user-domain item))
- (proxy (concat
- tramp-prefix-format proxy tramp-postfix-host-format))
- (entry
- (list (and (stringp host-port)
- (concat "^" (regexp-quote host-port) "$"))
- (and (stringp user-domain)
- (concat "^" (regexp-quote user-domain) "$"))
- (propertize proxy 'tramp-ad-hoc t))))
- (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
- ;; Add the hop.
- (add-to-list 'tramp-default-proxies-alist entry)
- (setq item (tramp-dissect-file-name proxy))))
- ;; Save the new value.
- (when (and hops tramp-save-ad-hoc-proxies)
- (customize-save-variable
- 'tramp-default-proxies-alist tramp-default-proxies-alist))
-
- ;; Look for proxy hosts to be passed.
- (setq choices tramp-default-proxies-alist)
- (while choices
- (setq item (pop choices)
- proxy (eval (nth 2 item)))
- (when (and
- ;; Host.
- (string-match-p
- (or (eval (nth 0 item)) "")
- (or (tramp-file-name-host-port (car target-alist)) ""))
- ;; User.
- (string-match-p
- (or (eval (nth 1 item)) "")
- (or (tramp-file-name-user-domain (car target-alist)) "")))
- (if (null proxy)
- ;; No more hops needed.
- (setq choices nil)
- ;; Replace placeholders.
- (setq proxy
- (format-spec
- proxy
- (format-spec-make
- ?u (or (tramp-file-name-user (car target-alist)) "")
- ?h (or (tramp-file-name-host (car target-alist)) ""))))
- (with-parsed-tramp-file-name proxy l
- ;; Add the hop.
- (push l target-alist)
- ;; Start next search.
- (setq choices tramp-default-proxies-alist)))))
-
- ;; Foreign and out-of-band methods are not supported for multi-hops.
- (when (cdr target-alist)
- (setq choices target-alist)
- (while (setq item (pop choices))
- (when (or (not (tramp-get-method-parameter item 'tramp-login-program))
- (tramp-get-method-parameter item 'tramp-copy-program))
- (setq tramp-default-proxies-alist saved-tdpa)
- (tramp-user-error
- vec "Method `%s' is not supported for multi-hops."
- (tramp-file-name-method item)))))
-
- ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the
- ;; host name in their command template. In this case, the remote
- ;; file name must use either a local host name (first hop), or a
- ;; host name matching the previous hop.
- (let ((previous-host (or tramp-local-host-regexp "")))
- (setq choices target-alist)
- (while (setq item (pop choices))
- (let ((host (tramp-file-name-host item)))
- (unless
- (or
- ;; The host name is used for the remote shell command.
- (member
- '("%h") (tramp-get-method-parameter item 'tramp-login-args))
- ;; The host name must match previous hop.
- (string-match-p previous-host host))
- (setq tramp-default-proxies-alist saved-tdpa)
- (tramp-user-error
- vec "Host name `%s' does not match `%s'" host previous-host))
- (setq previous-host (concat "^" (regexp-quote host) "$")))))
-
- ;; Result.
- target-alist))
-
(defun tramp-ssh-controlmaster-options (vec)
"Return the Control* arguments of the local ssh."
(cond
@@ -4940,7 +4851,7 @@ If there is just some editing, retry it after 5 seconds."
(run-at-time 5 nil 'tramp-timeout-session vec))
(tramp-message
vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
- (tramp-cleanup-connection vec 'keep-debug)))
+ (tramp-cleanup-connection vec 'keep-debug nil 'keep-processes)))
(defun tramp-maybe-open-connection (vec)
"Maybe open a connection VEC.
@@ -4961,11 +4872,8 @@ connection if a previous connection has died for some reason."
(not (tramp-file-name-equal-p
vec (car tramp-current-connection)))
(time-less-p
- ;; `current-time' can be removed once we get rid of Emacs 24.
- (time-since (or (cdr tramp-current-connection) (current-time)))
- ;; `seconds-to-time' can be removed once we get rid
- ;; of Emacs 24.
- (seconds-to-time (or tramp-connection-min-time-diff 0))))
+ (time-since (cdr tramp-current-connection))
+ (or tramp-connection-min-time-diff 0)))
(throw 'suppress 'suppress))
;; If too much time has passed since last command was sent, look
@@ -4976,11 +4884,9 @@ connection if a previous connection has died for some reason."
;; try to send a command from time to time, then look again
;; whether the process is really alive.
(condition-case nil
- ;; `seconds-to-time' can be removed once we get rid of Emacs 24.
- (when (and (time-less-p (seconds-to-time 60)
- (time-since
- (tramp-get-connection-property
- p "last-cmd-time" (seconds-to-time 0))))
+ (when (and (time-less-p
+ 60 (time-since
+ (tramp-get-connection-property p "last-cmd-time" 0)))
(process-live-p p))
(tramp-send-command vec "echo are you awake" t t)
(unless (and (process-live-p p)
@@ -5094,11 +5000,8 @@ connection if a previous connection has died for some reason."
;; we cannot use `tramp-get-connection-process'.
(tmpfile
(with-tramp-connection-property
- (get-process (tramp-buffer-name vec)) "temp-file"
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
+ (tramp-get-process vec) "temp-file"
+ (tramp-compat-make-temp-name)))
spec r-shell)
;; Add arguments for asynchronous processes.
@@ -5278,7 +5181,7 @@ the exit status."
"echo tramp_exit_status $?"
(if subshell " )" "")))
(with-current-buffer (tramp-get-connection-buffer vec)
- (unless (tramp-search-regexp "tramp_exit_status [0-9]+")
+ (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
@@ -5474,7 +5377,7 @@ Nonexistent directories are removed from spec."
;; cache the result for the session only. Otherwise, the
;; result is cached persistently.
(if (memq 'tramp-own-remote-path tramp-remote-path)
- (tramp-get-connection-process vec)
+ (tramp-get-process vec)
vec)
"remote-path"
(let* ((remote-path (copy-tree tramp-remote-path))
@@ -5682,8 +5585,7 @@ Nonexistent directories are removed from spec."
;; stat on Solaris is buggy. We've got reports for "SunOS 5.10"
;; and "SunOS 5.11" so far.
(unless (string-match-p
- (eval-when-compile (regexp-opt '("SunOS 5.10" "SunOS 5.11")))
- (tramp-get-connection-property vec "uname" ""))
+ tramp-sunos-unames (tramp-get-connection-property vec "uname" ""))
(tramp-message vec 5 "Finding a suitable `stat' command")
(let ((result (tramp-find-executable
vec "stat" (tramp-get-remote-path vec)))
@@ -5729,10 +5631,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(tramp-message vec 5 "Finding a suitable `touch' command")
(let ((result (tramp-find-executable
vec "touch" (tramp-get-remote-path vec)))
- (tmpfile
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
+ (tmpfile (tramp-make-tramp-temp-name vec)))
;; Busyboxes do support the "-t" option only when they have been
;; built with the DESKTOP config option. Let's check it.
(when result
@@ -5847,27 +5746,6 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
"import os; print (os.getuid())"
"import os, pwd; print ('\\\"' + pwd.getpwuid(os.getuid())[0] + '\\\"')"))))
-(defun tramp-get-remote-uid (vec id-format)
- "The uid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (let ((res
- (ignore-errors
- (cond
- ((tramp-get-remote-id vec)
- (tramp-get-remote-uid-with-id vec id-format))
- ((tramp-get-remote-perl vec)
- (tramp-get-remote-uid-with-perl vec id-format))
- ((tramp-get-remote-python vec)
- (tramp-get-remote-uid-with-python vec id-format))))))
- ;; Ensure there is a valid result.
- (cond
- ((and (equal id-format 'integer) (not (integerp res)))
- tramp-unknown-id-integer)
- ((and (equal id-format 'string) (not (stringp res)))
- tramp-unknown-id-string)
- (t res)))))
-
(defun tramp-get-remote-gid-with-id (vec id-format)
"Implement `tramp-get-remote-gid' for Tramp files using `id'."
(tramp-send-command-and-read
@@ -5898,27 +5776,6 @@ ID-FORMAT valid values are `string' and `integer'."
"import os; print (os.getgid())"
"import os, grp; print ('\\\"' + grp.getgrgid(os.getgid())[0] + '\\\"')"))))
-(defun tramp-get-remote-gid (vec id-format)
- "The gid of the remote connection VEC, in ID-FORMAT.
-ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "gid-%s" id-format)
- (let ((res
- (ignore-errors
- (cond
- ((tramp-get-remote-id vec)
- (tramp-get-remote-gid-with-id vec id-format))
- ((tramp-get-remote-perl vec)
- (tramp-get-remote-gid-with-perl vec id-format))
- ((tramp-get-remote-python vec)
- (tramp-get-remote-gid-with-python vec id-format))))))
- ;; Ensure there is a valid result.
- (cond
- ((and (equal id-format 'integer) (not (integerp res)))
- tramp-unknown-id-integer)
- ((and (equal id-format 'string) (not (stringp res)))
- tramp-unknown-id-string)
- (t res)))))
-
(defun tramp-get-remote-busybox (vec)
"Determine remote `busybox' command."
(with-tramp-connection-property vec "busybox"
@@ -5960,6 +5817,19 @@ ID-FORMAT valid values are `string' and `integer'."
vec (concat command " -A n </dev/null"))
command)))))
+(defun tramp-get-remote-chmod-h (vec)
+ "Check whether remote `chmod' supports nofollow argument."
+ (with-tramp-connection-property vec "chmod-h"
+ (tramp-message vec 5 "Finding a suitable `chmod' command with nofollow")
+ (let ((tmpfile (tramp-make-tramp-temp-name vec)))
+ (prog1
+ (tramp-send-command-and-check
+ vec
+ (format
+ "ln -s foo %s && chmod -h %s 0777"
+ (tramp-file-local-name tmpfile) (tramp-file-local-name tmpfile)))
+ (delete-file tmpfile)))))
+
(defun tramp-get-env-with-u-option (vec)
"Check, whether the remote `env' command supports the -u option."
(with-tramp-connection-property vec "env-u-option"
@@ -5977,10 +5847,9 @@ the length of the file to be compressed.
If no corresponding command is found, nil is returned."
(when (and (integerp tramp-inline-compress-start-size)
(> size tramp-inline-compress-start-size))
- (with-tramp-connection-property (tramp-get-connection-process vec) prop
+ (with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-compress vec)
- (tramp-get-connection-property
- (tramp-get-connection-process vec) prop nil))))
+ (tramp-get-connection-property (tramp-get-process vec) prop nil))))
(defun tramp-get-inline-coding (vec prop size)
"Return the coding command related to PROP.
@@ -5998,11 +5867,9 @@ function cell is returned to be applied on a buffer."
;; no inline coding is found.
(ignore-errors
(let ((coding
- (with-tramp-connection-property
- (tramp-get-connection-process vec) prop
+ (with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-encoding vec)
- (tramp-get-connection-property
- (tramp-get-connection-process vec) prop nil)))
+ (tramp-get-connection-property (tramp-get-process vec) prop nil)))
(prop1 (if (string-match-p "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
@@ -6080,9 +5947,6 @@ function cell is returned to be applied on a buffer."
;; likely to produce long command lines, and some shells choke on
;; long command lines.
;;
-;; * Don't search for perl5 and perl. Instead, only search for perl and
-;; then look if it's the right version (with `perl -v').
-;;
;; * When editing a remote CVS controlled file as a different user, VC
;; gets confused about the file locking status. Try to find out why
;; the workaround doesn't work.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index b76308ac441..8a48ffc09b8 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -90,7 +90,7 @@ For example, if the deprecated SMB1 protocol shall be used, add to
this variable (\"client min protocol=NT1\") ."
:group 'tramp
:type '(repeat string)
- :version "27.2")
+ :version "28.1")
(defvar tramp-smb-version nil
"Version string of the SMB client.")
@@ -293,6 +293,8 @@ See `tramp-actions-before-shell' for more info.")
(start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . ignore)
+ (tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
@@ -341,10 +343,9 @@ This can be used to disable echo etc."
"Invoke the SMB related OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
- (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(unless (memq system-type '(cygwin windows-nt))
@@ -432,16 +433,12 @@ pass to the OPERATION."
v tramp-file-missing
"Copying directory" "No such file or directory" dirname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(cond
;; We must use a local temporary directory.
((and t1 t2)
- (let ((tmpdir
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
+ (let ((tmpdir (tramp-compat-make-temp-name)))
(unwind-protect
(progn
(make-directory tmpdir)
@@ -469,10 +466,7 @@ pass to the OPERATION."
(localname (file-name-as-directory
(replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v))))
- (tmpdir (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory))))
+ (tmpdir (tramp-compat-make-temp-name))
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
@@ -556,10 +550,11 @@ pass to the OPERATION."
;; Handle KEEP-DATE argument.
(when keep-date
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes dirname))))
+ (file-attributes dirname))
+ (unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(unless keep-date
@@ -598,83 +593,81 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
tramp-file-missing
"Copying file" "No such file or directory" filename))
- (let ((tmpfile (file-local-copy filename)))
- (if tmpfile
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
+ (if-let ((tmpfile (file-local-copy filename)))
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (and (file-directory-p newname)
+ (directory-name-p newname))
+ (setq newname
+ (expand-file-name (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (tramp-compat-directory-name-p newname))
- (setq newname
- (expand-file-name (file-name-nondirectory filename) newname)))
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
- (unless (tramp-smb-get-share v)
- (tramp-error
- v 'file-error "Target `%s' must contain a share name" newname))
- (unless (tramp-smb-send-command
- v (format "put \"%s\" \"%s\""
- (tramp-compat-file-name-unquote filename)
- (tramp-smb-get-localname v)))
- (tramp-error
- v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-smb-get-share v)
+ (tramp-error
+ v 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v (format "put \"%s\" \"%s\""
+ (tramp-compat-file-name-unquote filename)
+ (tramp-smb-get-localname v)))
+ (tramp-error
+ v 'file-error "Cannot copy `%s' to `%s'" filename newname)))))
;; KEEP-DATE handling.
(when keep-date
- (set-file-times
+ (tramp-compat-set-file-times
newname
(tramp-compat-file-attribute-modification-time
- (file-attributes filename))))))
+ (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))))
-(defun tramp-smb-handle-delete-directory (directory &optional recursive _trash)
+(defun tramp-smb-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
- (setq directory (directory-file-name (expand-file-name directory)))
- (when (file-exists-p directory)
- (when recursive
- (mapc
- (lambda (file)
- (if (file-directory-p file)
- (delete-directory file recursive)
- (delete-file file)))
- ;; We do not want to delete "." and "..".
- (directory-files directory 'full directory-files-no-dot-files-regexp)))
-
- (with-parsed-tramp-file-name directory nil
+ (tramp-skeleton-delete-directory directory recursive trash
+ (when (file-exists-p directory)
+ (when recursive
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (delete-directory file recursive)
+ (delete-file file)))
+ ;; We do not want to delete "." and "..".
+ (directory-files directory 'full directory-files-no-dot-files-regexp)))
+
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-directory-properties v localname)
(unless (tramp-smb-send-command
v (format
"%s \"%s\""
- (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir")
+ (if (tramp-smb-get-cifs-capabilities v)
+ "posix_rmdir" "rmdir")
(tramp-smb-get-localname v)))
;; Error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(search-forward-regexp tramp-smb-errors nil t)
- (tramp-error
- v 'file-error "%s `%s'" (match-string 0) directory)))
+ (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)))
;; "rmdir" does not report an error. So we check ourselves.
(when (file-exists-p directory)
- (tramp-error
- v 'file-error "`%s' not removed." directory)))))
+ (tramp-error v 'file-error "`%s' not removed." directory)))))
-(defun tramp-smb-handle-delete-file (filename &optional _trash)
+(defun tramp-smb-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(setq filename (expand-file-name filename))
(when (file-exists-p filename)
@@ -682,20 +675,21 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v localname)
- (unless (tramp-smb-send-command
- v (format
- "%s \"%s\""
- (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
- (tramp-smb-get-localname v)))
- ;; Error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (search-forward-regexp tramp-smb-errors nil t)
- (tramp-error
- v 'file-error "%s `%s'" (match-string 0) filename))))))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash filename)
+ (unless (tramp-smb-send-command
+ v (format
+ "%s \"%s\""
+ (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
+ (tramp-smb-get-localname v)))
+ ;; Error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (search-forward-regexp tramp-smb-errors nil t)
+ (tramp-error v 'file-error "%s `%s'" (match-string 0) filename)))))))
(defun tramp-smb-handle-directory-files
- (directory &optional full match nosort _count)
+ (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -709,14 +703,22 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(delete nil
(mapcar (lambda (x) (when (string-match-p match x) x))
result))))
- ;; Append directory.
+
+ ;; Sort them if necessary.
+ (unless nosort
+ (setq result (sort result #'string-lessp)))
+
+ ;; Return count number of results.
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+
+ ;; Prepend directory.
(when full
(setq result
(mapcar
- (lambda (x) (format "%s/%s" directory x))
+ (lambda (x) (format "%s/%s" (directory-file-name directory) x))
result)))
- ;; Sort them if necessary.
- (unless nosort (setq result (sort result #'string-lessp)))
+
result))
(defun tramp-smb-handle-expand-file-name (name &optional dir)
@@ -880,23 +882,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(while (not (eobp))
(cond
((looking-at
- "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
+ (concat
+ "Size:\\s-+\\([[:digit:]]+\\)\\s-+"
+ "Blocks:\\s-+[[:digit:]]+\\s-+\\(\\w+\\)"))
(setq size (string-to-number (match-string 1))
id (if (string-equal "directory" (match-string 2)) t
(if (string-equal "symbolic" (match-string 2)) ""))))
((looking-at
- "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)")
+ "Inode:\\s-+\\([[:digit:]]+\\)\\s-+Links:\\s-+\\([[:digit:]]+\\)")
(setq inode (string-to-number (match-string 1))
link (string-to-number (match-string 2))))
((looking-at
- "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)")
+ (concat
+ "Access:\\s-+([[:digit:]]+/\\(\\S-+\\))\\s-+"
+ "Uid:\\s-+\\([[:digit:]]+\\)\\s-+"
+ "Gid:\\s-+\\([[:digit:]]+\\)"))
(setq mode (match-string 1)
uid (if (equal id-format 'string) (match-string 2)
(string-to-number (match-string 2)))
gid (if (equal id-format 'string) (match-string 3)
(string-to-number (match-string 3)))))
((looking-at
- "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
+ (concat
+ "Access:\\s-+"
+ "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
(setq atime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -906,7 +916,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(string-to-number (match-string 2)) ;; month
(string-to-number (match-string 1))))) ;; year
((looking-at
- "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
+ (concat
+ "Modify:\\s-+"
+ "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
(setq mtime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -916,7 +929,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(string-to-number (match-string 2)) ;; month
(string-to-number (match-string 1))))) ;; year
((looking-at
- "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)")
+ (concat
+ "Change:\\s-+"
+ "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
(setq ctime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -992,10 +1008,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- " blocks of size \\([[:digit:]]+\\)"
- "\\. \\([[:digit:]]+\\) blocks available")))
+ (concat "[[:space:]]*\\([[:digit:]]+\\)"
+ " blocks of size \\([[:digit:]]+\\)"
+ "\\. \\([[:digit:]]+\\) blocks available"))
(setq blocksize (string-to-number (match-string 2))
total (* blocksize (string-to-number (match-string 1)))
avail (* blocksize (string-to-number (match-string 3)))))
@@ -1025,7 +1040,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (expand-file-name filename))
(unless switches (setq switches ""))
;; Mark trailing "/".
- (when (and (tramp-compat-directory-name-p filename)
+ (when (and (directory-name-p filename)
(not full-directory-p))
(setq switches (concat switches "F")))
(if full-directory-p
@@ -1377,7 +1392,7 @@ component is used as the target of the symlink."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
@@ -1479,7 +1494,7 @@ component is used as the target of the symlink."
;; This is meant for traces, and returning from the
;; function. No error is propagated outside, due to
;; the `ignore-errors' closure.
- (unless (tramp-search-regexp "tramp_exit_status [0-9]+")
+ (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
(tramp-error
v 'file-error
"Couldn't find exit status of `%s'" tramp-smb-acl-program))
@@ -1493,15 +1508,17 @@ component is used as the target of the symlink."
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")))))))
-(defun tramp-smb-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (when (tramp-smb-get-cifs-capabilities v)
- (tramp-flush-file-properties v localname)
- (unless (tramp-smb-send-command
- v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
- (tramp-error
- v 'file-error "Error while changing file's mode %s" filename)))))
+ ;; smbclient chmod does not support nofollow.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (when (tramp-smb-get-cifs-capabilities v)
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-smb-send-command
+ v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
+ (tramp-error
+ v 'file-error "Error while changing file's mode %s" filename))))))
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
@@ -1613,8 +1630,9 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
;; Set file modification time.
(when (or (eq visit t) (stringp visit))
(set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ (or (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))
+ (current-time))))
;; The end.
(when (and (null noninteractive)
@@ -1722,21 +1740,21 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
;; Entries provided by smbclient DIR aren't fully regular.
;; They should have the format
;;
-;; \s-\{2,2} - leading spaces
+;; \s-\{2,2\} - leading spaces
;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound
;; \s-+[ADHRSV]* - permissions, 7 chars, right bound
;; \s- - space delimiter
-;; \s-+[0-9]+ - size, 8 chars, right bound
+;; \s-+[[:digit:]]+ - size, 8 chars, right bound
;; \s-\{2,2\} - space delimiter
;; \w\{3,3\} - weekday
;; \s- - space delimiter
;; \w\{3,3\} - month
;; \s- - space delimiter
-;; [ 12][0-9] - day
+;; [ 12][[:digit:]] - day
;; \s- - space delimiter
-;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
+;; [[:digit:]]\{2,2\}:[[:digit:]]\{2,2\}:[[:digit:]]\{2,2\} - time
;; \s- - space delimiter
-;; [0-9]\{4,4\} - year
+;; [[:digit:]]\{4,4\} - year
;;
;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
;; has function display_finfo:
@@ -1784,13 +1802,14 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
(cl-block nil
;; year.
- (if (string-match "\\([0-9]+\\)$" line)
+ (if (string-match "\\([[:digit:]]+\\)$" line)
(setq year (string-to-number (match-string 1 line))
line (substring line 0 -5))
(cl-return))
;; time.
- (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
+ (if (string-match
+ "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)$" line)
(setq hour (string-to-number (match-string 1 line))
min (string-to-number (match-string 2 line))
sec (string-to-number (match-string 3 line))
@@ -1798,7 +1817,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
(cl-return))
;; day.
- (if (string-match "\\([0-9]+\\)$" line)
+ (if (string-match "\\([[:digit:]]+\\)$" line)
(setq day (string-to-number (match-string 1 line))
line (substring line 0 -3))
(cl-return))
@@ -1815,7 +1834,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
(cl-return))
;; size.
- (if (string-match "\\([0-9]+\\)$" line)
+ (if (string-match "\\([[:digit:]]+\\)$" line)
(let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
(setq size (string-to-number (match-string 1 line)))
(when (string-match
@@ -1870,7 +1889,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
(if (and (process-live-p (tramp-get-connection-process vec))
(tramp-get-connection-property vec "posix" t))
(with-tramp-connection-property
- (tramp-get-connection-process vec) "cifs-capabilities"
+ (tramp-get-process vec) "cifs-capabilities"
(save-match-data
(when (tramp-smb-send-command vec "posix")
(with-current-buffer (tramp-get-connection-buffer vec)
@@ -1887,8 +1906,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
;; When we are not logged in yet, we return nil.
(if (and (tramp-smb-get-share vec)
(process-live-p (tramp-get-connection-process vec)))
- (with-tramp-connection-property
- (tramp-get-connection-process vec) "stat-capability"
+ (with-tramp-connection-property (tramp-get-process vec) "stat-capability"
(tramp-smb-send-command vec "stat \"/\""))))
@@ -1950,11 +1968,9 @@ If ARGUMENT is non-nil, use it as argument for
;; connection timeout.
(with-current-buffer buf
(goto-char (point-min))
- ;; `seconds-to-time' can be removed once we get rid of Emacs 24.
- (when (and (time-less-p (seconds-to-time 60)
- (time-since
- (tramp-get-connection-property
- p "last-cmd-time" (seconds-to-time 0))))
+ (when (and (time-less-p
+ 60 (time-since
+ (tramp-get-connection-property p "last-cmd-time" 0)))
(process-live-p p)
(re-search-forward tramp-smb-errors nil t))
(delete-process p)
@@ -2025,7 +2041,7 @@ If ARGUMENT is non-nil, use it as argument for
(set-process-query-on-exit-flag p nil)
(condition-case err
- (let (tramp-message-show-message)
+ (let ((inhibit-message t))
;; Play login scenario.
(tramp-process-actions
p vec nil
@@ -2131,8 +2147,7 @@ Removes smb prompt. Returns nil if an error message has appeared."
"%s %s"
tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
- (set (make-local-variable 'kill-buffer-hook)
- '(tramp-smb-kill-winexe-function))
+ (add-hook 'kill-buffer-hook #'tramp-smb-kill-winexe-function nil t)
;; Suppress "^M". Shouldn't we specify utf8?
(set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 4af58618a6a..558a57b2ead 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -132,6 +132,8 @@ See `tramp-actions-before-shell' for more info.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . tramp-sudoedit-handle-get-remote-gid)
+ (tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
@@ -153,10 +155,9 @@ See `tramp-actions-before-shell' for more info.")
"Invoke the SUDOEDIT handler for OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
- (let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
- (if fn
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###tramp-autoload
(tramp--with-startup
@@ -248,7 +249,7 @@ absolute file names."
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
- (not (tramp-compat-directory-name-p newname)))
+ (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(if (or (and (file-remote-p filename) (not t1))
@@ -282,7 +283,8 @@ absolute file names."
;; Set the time and mode. Mask possible errors.
(when keep-date
(ignore-errors
- (set-file-times newname file-times)
+ (tramp-compat-set-file-times
+ newname file-times (unless ok-if-already-exists 'nofollow))
(set-file-modes newname file-modes)))
;; Handle `preserve-extended-attributes'. We ignore possible
@@ -303,8 +305,8 @@ absolute file names."
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -319,29 +321,25 @@ absolute file names."
(defun tramp-sudoedit-handle-delete-directory
(directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
- (setq directory (expand-file-name directory))
- (with-parsed-tramp-file-name directory nil
- (tramp-flush-directory-properties v localname)
- (unless
- (tramp-sudoedit-send-command
- v (or (and trash "trash")
- (if recursive '("rm" "-rf") "rmdir"))
- (tramp-compat-file-name-unquote localname))
+ (tramp-skeleton-delete-directory directory recursive trash
+ (unless (tramp-sudoedit-send-command
+ v (if recursive '("rm" "-rf") "rmdir")
+ (tramp-compat-file-name-unquote localname))
(tramp-error v 'file-error "Couldn't delete %s" directory))))
(defun tramp-sudoedit-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
- (unless
- (tramp-sudoedit-send-command
- v (if (and trash delete-by-moving-to-trash) "trash" "rm")
- (tramp-compat-file-name-unquote localname))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error "Couldn't delete %s" filename)))))
+ (if (and delete-by-moving-to-trash trash)
+ (move-file-to-trash filename)
+ (unless (tramp-sudoedit-send-command
+ v "rm" (tramp-compat-file-name-unquote localname))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error "Couldn't delete %s" filename))))))
(defun tramp-sudoedit-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files.
@@ -373,7 +371,7 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
+ (with-tramp-connection-property (tramp-get-process vec) "acl-p"
(zerop (tramp-call-process vec "getfacl" nil nil nil "/"))))
(defun tramp-sudoedit-handle-file-acl (filename)
@@ -464,19 +462,21 @@ the result will be a local, non-Tramp, file name."
(tramp-sudoedit-send-command
v "test" "-r" (tramp-compat-file-name-unquote localname)))))
-(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional _flag)
+(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
- (unless (tramp-sudoedit-send-command
- v "chmod" (format "%o" mode)
- (tramp-compat-file-name-unquote localname))
- (tramp-error
- v 'file-error "Error while changing file's mode %s" filename))))
+ ;; It is unlikely that "chmod -h" works.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-sudoedit-send-command
+ v "chmod" (format "%o" mode)
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error
+ v 'file-error "Error while changing file's mode %s" filename)))))
(defun tramp-sudoedit-remote-selinux-p (vec)
"Check, whether SELINUX is enabled on the remote host."
- (with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p"
+ (with-tramp-connection-property (tramp-get-process vec) "selinux-p"
(zerop (tramp-call-process vec "selinuxenabled"))))
(defun tramp-sudoedit-handle-file-selinux-context (filename)
@@ -484,9 +484,8 @@ the result will be a local, non-Tramp, file name."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-selinux-context"
(let ((context '(nil nil nil nil))
- (regexp (eval-when-compile
- (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):"
- "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))))
+ (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):"
+ "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)")))
(when (and (tramp-sudoedit-remote-selinux-p v)
(tramp-sudoedit-send-command
v "ls" "-d" "-Z"
@@ -511,10 +510,9 @@ the result will be a local, non-Tramp, file name."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (eval-when-compile
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)")))
+ (concat "[[:space:]]*\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"))
(list (string-to-number (match-string 1))
;; The second value is the used size. We need the
;; free size.
@@ -522,7 +520,7 @@ the result will be a local, non-Tramp, file name."
(string-to-number (match-string 2)))
(string-to-number (match-string 3)))))))))
-(defun tramp-sudoedit-handle-set-file-times (filename &optional time _flag)
+(defun tramp-sudoedit-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
@@ -535,14 +533,14 @@ the result will be a local, non-Tramp, file name."
(tramp-sudoedit-send-command
v "env" "TZ=UTC" "touch" "-t"
(format-time-string "%Y%m%d%H%M.%S" time t)
+ (if (eq flag 'nofollow) "-h" "")
(tramp-compat-file-name-unquote localname)))))
(defun tramp-sudoedit-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
(funcall
- (if (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
+ (if (directory-name-p filename) #'file-name-as-directory #'identity)
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
@@ -642,8 +640,8 @@ component is used as the target of the symlink."
(defun tramp-sudoedit-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (setq newname (expand-file-name newname))
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
@@ -687,21 +685,19 @@ component is used as the target of the symlink."
(tramp-flush-file-property v localname "file-selinux-context"))
t)))))
-(defun tramp-sudoedit-get-remote-uid (vec id-format)
+(defun tramp-sudoedit-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (if (equal id-format 'integer)
- (tramp-sudoedit-send-command-and-read vec "id" "-u")
- (tramp-sudoedit-send-command-string vec "id" "-un"))))
+ (if (equal id-format 'integer)
+ (tramp-sudoedit-send-command-and-read vec "id" "-u")
+ (tramp-sudoedit-send-command-string vec "id" "-un")))
-(defun tramp-sudoedit-get-remote-gid (vec id-format)
+(defun tramp-sudoedit-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "gid-%s" id-format)
- (if (equal id-format 'integer)
- (tramp-sudoedit-send-command-and-read vec "id" "-g")
- (tramp-sudoedit-send-command-string vec "id" "-gn"))))
+ (if (equal id-format 'integer)
+ (tramp-sudoedit-send-command-and-read vec "id" "-g")
+ (tramp-sudoedit-send-command-string vec "id" "-gn")))
(defun tramp-sudoedit-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
@@ -709,21 +705,22 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-sudoedit-send-command
v "chown"
(format "%d:%d"
- (or uid (tramp-sudoedit-get-remote-uid v 'integer))
- (or gid (tramp-sudoedit-get-remote-gid v 'integer)))
+ (or uid (tramp-get-remote-uid v 'integer))
+ (or gid (tramp-get-remote-gid v 'integer)))
(tramp-unquote-file-local-name filename))))
(defun tramp-sudoedit-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (let ((uid (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- (tramp-sudoedit-get-remote-uid v 'integer)))
- (gid (or (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- (tramp-sudoedit-get-remote-gid v 'integer)))
- (modes (tramp-default-file-modes filename)))
+ (let* ((uid (or (tramp-compat-file-attribute-user-id
+ (file-attributes filename 'integer))
+ (tramp-get-remote-uid v 'integer)))
+ (gid (or (tramp-compat-file-attribute-group-id
+ (file-attributes filename 'integer))
+ (tramp-get-remote-gid v 'integer)))
+ (flag (and (eq mustbenew 'excl) 'nofollow))
+ (modes (tramp-default-file-modes filename flag)))
(prog1
(tramp-handle-write-region
start end filename append visit lockname mustbenew)
@@ -737,7 +734,7 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
gid))
(tramp-set-file-uid-gid filename uid gid))
- (set-file-modes filename modes)))))
+ (tramp-compat-set-file-modes filename modes flag)))))
;; Internal functions.
@@ -782,14 +779,7 @@ connection if a previous connection has died for some reason."
(tramp-set-connection-local-variables vec)
;; Mark it as connected.
- (tramp-set-connection-property p "connected" t))
-
- ;; In `tramp-check-cached-permissions', the connection properties
- ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
- (tramp-sudoedit-get-remote-uid vec 'integer)
- (tramp-sudoedit-get-remote-gid vec 'integer)
- (tramp-sudoedit-get-remote-uid vec 'string)
- (tramp-sudoedit-get-remote-gid vec 'string)))
+ (tramp-set-connection-property p "connected" t))))
(defun tramp-sudoedit-send-command (vec &rest args)
"Send commands ARGS to connection VEC.
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index 6a044e58840..f368f72a8dc 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/tramp-uu.el
@@ -94,8 +94,3 @@
(provide 'tramp-uu)
;;; tramp-uu.el ends here
-
-;; Local Variables:
-;; mode: Emacs-Lisp
-;; coding: utf-8
-;; End:
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 08bc0ffdd7d..a98d478bc1a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -7,8 +7,8 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.4.5-pre
-;; Package-Requires: ((emacs "24.4"))
+;; Version: 2.5.0-pre
+;; Package-Requires: ((emacs "25.1"))
;; Package-Type: multi
;; URL: https://savannah.gnu.org/projects/tramp
@@ -64,6 +64,7 @@
;; Pacify byte-compiler.
(require 'cl-lib)
+(declare-function file-notify-rm-watch "filenotify")
(declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms)
@@ -79,6 +80,7 @@
(eval-and-compile ;; So it's also available in tramp-loaddefs.el!
(defvar tramp--startup-hook nil
"Forms to be executed at the end of tramp.el.")
+ (put 'tramp--startup-hook 'tramp-suppress-trace t)
(defmacro tramp--with-startup (&rest body)
"Schedule BODY to be executed at the end of tramp.el."
@@ -247,6 +249,10 @@ pair of the form (KEY VALUE). The following KEYs are defined:
parameters to suppress diagnostic messages, in order not to
tamper the process output.
+ * `tramp-direct-async-args'
+ An additional argument when a direct asynchronous process is
+ started. Used so far only in the \"mock\" method of tramp-tests.el.
+
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
the file; this might be the absolute filename of scp or the name of
@@ -559,7 +565,7 @@ Sometimes the prompt is reported to look like \"login as:\"."
;; Allow also [] style prompts. They can appear only during
;; connection initialization; Tramp redefines the prompt afterwards.
(concat "\\(?:^\\|\r\\)"
- "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
+ "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[[:digit:];]*[[:alpha:]] *\\)*")
"Regexp to match prompts from remote shell.
Normally, Tramp expects you to configure `shell-prompt-pattern'
correctly, but sometimes it happens that you are connecting to a
@@ -578,6 +584,11 @@ This regexp must match both `tramp-initial-end-of-output' and
"Regexp matching password-like prompts.
The regexp should match at end of buffer.
+This variable is, by default, initialised from
+`password-word-equivalents' when Tramp is loaded, and it is
+usually more convenient to add new passphrases to that variable
+instead of altering this variable.
+
The `sudo' program appears to insert a `^@' character into the prompt."
:version "24.4"
:type 'regexp)
@@ -600,7 +611,7 @@ The `sudo' program appears to insert a `^@' character into the prompt."
"\\|"
"^.*\\("
;; Here comes a list of regexes, separated by \\|
- "Received signal [0-9]+"
+ "Received signal [[:digit:]]+"
"\\).*")
"Regexp matching a `login failed' message.
The regexp should match at end of buffer."
@@ -745,7 +756,7 @@ to be set, depending on VALUE."
tramp-postfix-host-format (tramp-build-postfix-host-format)
tramp-postfix-host-regexp (tramp-build-postfix-host-regexp)
tramp-remote-file-name-spec-regexp
- (tramp-build-remote-file-name-spec-regexp)
+ (tramp-build-remote-file-name-spec-regexp)
tramp-file-name-structure (tramp-build-file-name-structure)
tramp-file-name-regexp (tramp-build-file-name-regexp)
tramp-completion-file-name-regexp
@@ -796,9 +807,9 @@ Used in `tramp-make-tramp-file-name'.")
Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-method-regexp-alist
- '((default . "[a-zA-Z0-9-]+")
+ '((default . "[[:alnum:]-]+")
(simplified . "")
- (separate . "[a-zA-Z0-9-]*"))
+ (separate . "[[:alnum:]-]*"))
"Alist mapping Tramp syntax to regexps matching methods identifiers.")
(defun tramp-build-method-regexp ()
@@ -842,7 +853,7 @@ Derived from `tramp-postfix-method-format'.")
"Regexp matching delimiter between user and domain names.
Derived from `tramp-prefix-domain-format'.")
-(defconst tramp-domain-regexp "[a-zA-Z0-9_.-]+"
+(defconst tramp-domain-regexp "[[:alnum:]_.-]+"
"Regexp matching domain names.")
(defconst tramp-user-with-domain-regexp
@@ -859,7 +870,7 @@ Used in `tramp-make-tramp-file-name'.")
"Regexp matching delimiter between user and host names.
Derived from `tramp-postfix-user-format'.")
-(defconst tramp-host-regexp "[a-zA-Z0-9_.%-]+"
+(defconst tramp-host-regexp "[[:alnum:]_.%-]+"
"Regexp matching host names.")
(defconst tramp-prefix-ipv6-format-alist
@@ -887,7 +898,7 @@ Derived from `tramp-prefix-ipv6-format'.")
;; The following regexp is a bit sloppy. But it shall serve our
;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
;; "::ffff:192.168.0.1".
-(defconst tramp-ipv6-regexp "\\(?:[a-zA-Z0-9]*:\\)+[a-zA-Z0-9.]+"
+(defconst tramp-ipv6-regexp "\\(?:[[:alnum:]]*:\\)+[[:alnum:].]+"
"Regexp matching IPv6 addresses.")
(defconst tramp-postfix-ipv6-format-alist
@@ -919,7 +930,7 @@ Derived from `tramp-postfix-ipv6-format'.")
"Regexp matching delimiter between host names and port numbers.
Derived from `tramp-prefix-port-format'.")
-(defconst tramp-port-regexp "[0-9]+"
+(defconst tramp-port-regexp "[[:digit:]]+"
"Regexp matching port numbers.")
(defconst tramp-host-with-port-regexp
@@ -1238,6 +1249,7 @@ the (optional) timestamp of last activity on this connection.")
"Password save function.
Will be called once the password has been verified by successful
authentication.")
+(put 'tramp-password-save-function 'tramp-suppress-trace t)
(defconst tramp-completion-file-name-handler-alist
'((file-name-all-completions
@@ -1261,7 +1273,7 @@ calling HANDLER.")
;; data structure.
;; The basic structure for remote file names. We use a list :type,
-;; in order to be compatible with Emacs 24 and 25.
+;; in order to be compatible with Emacs 25.
(cl-defstruct (tramp-file-name (:type list) :named)
method user domain host port localname hop)
@@ -1287,7 +1299,7 @@ If nil, return `tramp-default-port'."
(or (tramp-file-name-port vec)
(tramp-get-method-parameter vec 'tramp-default-port)))
-;; Comparision of file names is performed by `tramp-equal-remote'.
+;; Comparison of file names is performed by `tramp-equal-remote'.
(defun tramp-file-name-equal-p (vec1 vec2)
"Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
(and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
@@ -1309,9 +1321,10 @@ entry does not exist, return nil."
;; We use the cached property.
(tramp-get-connection-property vec hash-entry nil)
;; Use the static value from `tramp-methods'.
- (let ((methods-entry
- (assoc param (assoc (tramp-file-name-method vec) tramp-methods))))
- (when methods-entry (cadr methods-entry))))))
+ (when-let ((methods-entry
+ (assoc
+ param (assoc (tramp-file-name-method vec) tramp-methods))))
+ (cadr methods-entry)))))
;; The localname can be quoted with "/:". Extract this.
(defun tramp-file-name-unquote-localname (vec)
@@ -1371,8 +1384,8 @@ This is METHOD, if non-nil. Otherwise, do a lookup in
(setq item (pop choices))
(when (and (string-match-p (or (nth 0 item) "") (or host ""))
(string-match-p (or (nth 1 item) "") (or user "")))
- (setq lmethod (nth 2 item))
- (setq choices nil)))
+ (setq lmethod (nth 2 item)
+ choices nil)))
lmethod)
tramp-default-method)))
;; We must mark, whether a default value has been used.
@@ -1392,8 +1405,8 @@ This is USER, if non-nil. Otherwise, do a lookup in
(setq item (pop choices))
(when (and (string-match-p (or (nth 0 item) "") (or method ""))
(string-match-p (or (nth 1 item) "") (or host "")))
- (setq luser (nth 2 item))
- (setq choices nil)))
+ (setq luser (nth 2 item)
+ choices nil)))
luser)
tramp-default-user)))
;; We must mark, whether a default value has been used.
@@ -1413,8 +1426,8 @@ This is HOST, if non-nil. Otherwise, do a lookup in
(setq item (pop choices))
(when (and (string-match-p (or (nth 0 item) "") (or method ""))
(string-match-p (or (nth 1 item) "") (or user "")))
- (setq lhost (nth 2 item))
- (setq choices nil)))
+ (setq lhost (nth 2 item)
+ choices nil)))
lhost)
tramp-default-host)))
;; We must mark, whether a default value has been used.
@@ -1476,16 +1489,13 @@ default values are used."
:method method :user user :domain domain :host host
:port port :localname localname :hop hop))
;; The method must be known.
- (unless (or nodefault (tramp-completion-mode-p)
+ (unless (or nodefault non-essential
(string-equal method tramp-default-method-marker)
(assoc method tramp-methods))
(tramp-user-error
v "Method `%s' is not known." method))
;; Only some methods from tramp-sh.el do support multi-hops.
- (when (and
- hop
- (or (not (tramp-get-method-parameter v 'tramp-login-program))
- (tramp-get-method-parameter v 'tramp-copy-program)))
+ (unless (or (null hop) nodefault non-essential (tramp-multi-hop-p v))
(tramp-user-error
v "Method `%s' is not supported for multi-hops." method)))))))
@@ -1499,8 +1509,7 @@ See `tramp-dissect-file-name' for details."
tramp-postfix-host-format name))
nodefault)))
;; Only some methods from tramp-sh.el do support multi-hops.
- (when (or (not (tramp-get-method-parameter v 'tramp-login-program))
- (tramp-get-method-parameter v 'tramp-copy-program))
+ (unless (or nodefault non-essential (tramp-multi-hop-p v))
(tramp-user-error
v "Method `%s' is not supported for multi-hops."
(tramp-file-name-method v)))
@@ -1633,6 +1642,15 @@ from the default one."
(or (tramp-get-connection-property vec "process-name" nil)
(tramp-buffer-name vec)))
+(defun tramp-get-process (vec-or-proc)
+ "Get the default connection process to be used for VEC-OR-PROC.
+Return `tramp-cache-undefined' in case it doesn't exist."
+ (or (and (tramp-file-name-p vec-or-proc)
+ (get-buffer-process (tramp-buffer-name vec-or-proc)))
+ (and (processp vec-or-proc)
+ (tramp-get-process (process-get vec-or-proc 'vector)))
+ tramp-cache-undefined))
+
(defun tramp-get-connection-process (vec)
"Get the connection process to be used for VEC.
In case a second asynchronous communication has been started, it is different
@@ -1675,11 +1693,10 @@ version, the function does nothing."
(format "*debug tramp/%s %s*" method host-port))))
(defconst tramp-debug-outline-regexp
- (eval-when-compile
- (concat
- "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ " ;; Timestamp.
- "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread.
- "[a-z0-9-]+ (\\([0-9]+\\)) #")) ;; Function name, verbosity.
+ (concat
+ "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp.
+ "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread.
+ "[[:alnum:]-]+ (\\([[:digit:]]+\\)) #") ;; Function name, verbosity.
"Used for highlighting Tramp debug buffers in `outline-mode'.")
(defconst tramp-debug-font-lock-keywords
@@ -1752,29 +1769,10 @@ ARGUMENTS to actually emit the message (if applicable)."
(setq btf (nth 1 (backtrace-frame btn)))
(if (not btf)
(setq fn "")
- (when (symbolp btf)
- (setq fn (symbol-name btf))
- (unless
- (and
- (string-match-p "^tramp" fn)
- (not
- (string-match-p
- (eval-when-compile
- (concat
- "^"
- (regexp-opt
- '("tramp-backtrace"
- "tramp-compat-funcall"
- "tramp-debug-message"
- "tramp-error"
- "tramp-error-with-buffer"
- "tramp-message"
- "tramp-signal-hook-function"
- "tramp-user-error")
- t)
- "$"))
- fn)))
- (setq fn nil)))
+ (and (symbolp btf) (setq fn (symbol-name btf))
+ (or (not (string-match-p "^tramp" fn))
+ (get btf 'tramp-suppress-trace))
+ (setq fn nil))
(setq btn (1+ btn))))
;; The following code inserts filename and line number. Should
;; be inactive by default, because it is time consuming.
@@ -1789,11 +1787,11 @@ ARGUMENTS to actually emit the message (if applicable)."
;; The message.
(insert (apply #'format-message fmt-string arguments))))
-(defvar tramp-message-show-message (null noninteractive)
- "Show Tramp message in the minibuffer.
-This variable is used to suppress progress reporter output, and
-to disable messages from `tramp-error'. Those messages are
-visible anyway, because an error is raised.")
+(put #'tramp-debug-message 'tramp-suppress-trace t)
+
+(defvar tramp-inhibit-progress-reporter nil
+ "Show Tramp progress reporter in the minibuffer.
+This variable is used to disable concurrent progress reporter messages.")
(defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
"Emit a message depending on verbosity level.
@@ -1810,8 +1808,9 @@ control string and the remaining ARGUMENTS to actually emit the message (if
applicable)."
(ignore-errors
(when (<= level tramp-verbose)
- ;; Display only when there is a minimum level.
- (when (and tramp-message-show-message (<= level 3))
+ ;; Display only when there is a minimum level, and the progress
+ ;; reporter doesn't suppress further messages.
+ (when (and (<= level 3) (null tramp-inhibit-progress-reporter))
(apply #'message
(concat
(cond
@@ -1843,6 +1842,8 @@ applicable)."
(concat (format "(%d) # " level) fmt-string)
arguments))))))
+(put #'tramp-message 'tramp-suppress-trace t)
+
(defsubst tramp-backtrace (&optional vec-or-proc)
"Dump a backtrace into the debug buffer.
If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This
@@ -1853,13 +1854,16 @@ function is meant for debugging purposes."
vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
(with-output-to-temp-buffer "*debug tramp*" (backtrace)))))
+(put #'tramp-backtrace 'tramp-suppress-trace t)
+
(defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments)
"Emit an error.
VEC-OR-PROC identifies the connection to use, SIGNAL is the
signal identifier to be raised, remaining arguments passed to
`tramp-message'. Finally, signal SIGNAL is raised with
FMT-STRING and ARGUMENTS."
- (let (tramp-message-show-message signal-hook-function)
+ (let ((inhibit-message t)
+ signal-hook-function)
(tramp-backtrace vec-or-proc)
(unless arguments
;; FMT-STRING could be just a file name, as in
@@ -1877,6 +1881,8 @@ FMT-STRING and ARGUMENTS."
(signal signal (list (substring-no-properties
(apply #'format-message fmt-string arguments))))))
+(put #'tramp-error 'tramp-suppress-trace t)
+
(defsubst tramp-error-with-buffer
(buf vec-or-proc signal fmt-string &rest arguments)
"Emit an error, and show BUF.
@@ -1894,13 +1900,13 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(apply #'tramp-error vec-or-proc signal fmt-string arguments)
;; Save exit.
(when (and buf
- tramp-message-show-message
(not (zerop tramp-verbose))
;; Do not show when flagged from outside.
- (not (tramp-completion-mode-p))
+ (not non-essential)
;; Show only when Emacs has started already.
(current-message))
- (let ((enable-recursive-minibuffers t))
+ (let ((enable-recursive-minibuffers t)
+ inhibit-message)
;; `tramp-error' does not show messages. So we must do it
;; ourselves.
(apply #'message fmt-string arguments)
@@ -1912,19 +1918,21 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
+(put #'tramp-error-with-buffer 'tramp-suppress-trace t)
+
;; We must make it a defun, because it is used earlier already.
(defun tramp-user-error (vec-or-proc fmt-string &rest arguments)
"Signal a user error (or \"pilot error\")."
(unwind-protect
(apply #'tramp-error vec-or-proc 'user-error fmt-string arguments)
;; Save exit.
- (when (and tramp-message-show-message
- (not (zerop tramp-verbose))
+ (when (and (not (zerop tramp-verbose))
;; Do not show when flagged from outside.
- (not (tramp-completion-mode-p))
+ (not non-essential)
;; Show only when Emacs has started already.
(current-message))
- (let ((enable-recursive-minibuffers t))
+ (let ((enable-recursive-minibuffers t)
+ inhibit-message)
;; `tramp-error' does not show messages. So we must do it ourselves.
(apply #'message fmt-string arguments)
(discard-input)
@@ -1934,18 +1942,21 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
+(put #'tramp-user-error 'tramp-suppress-trace t)
+
(defmacro tramp-with-demoted-errors (vec-or-proc format &rest body)
"Execute BODY while redirecting the error message to `tramp-message'.
BODY is executed like wrapped by `with-demoted-errors'. FORMAT
is a format-string containing a %-sequence meaning to substitute
the resulting error message."
- (declare (debug (symbolp body))
- (indent 2))
+ (declare (indent 2) (debug (symbolp form body)))
(let ((err (make-symbol "err")))
`(condition-case-unless-debug ,err
(progn ,@body)
(error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
+(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
+
;; This function provides traces in case of errors not triggered by
;; Tramp functions.
(defun tramp-signal-hook-function (error-symbol data)
@@ -1957,6 +1968,8 @@ the resulting error message."
(car tramp-current-connection) error-symbol
"%s" (mapconcat (lambda (x) (format "%s" x)) data " "))))
+(put #'tramp-signal-hook-function 'tramp-suppress-trace t)
+
(defmacro with-parsed-tramp-file-name (filename var &rest body)
"Parse a Tramp filename and make components available in the body.
@@ -1973,12 +1986,14 @@ Remaining args are Lisp expressions to be evaluated (inside an implicit
If VAR is nil, then we bind `v' to the structure and `method', `user',
`domain', `host', `port', `localname', `hop' to the components."
+ (declare (indent 2) (debug (form symbolp body)))
(let ((bindings
- (mapcar (lambda (elem)
- `(,(if var (intern (format "%s-%s" var elem)) elem)
- (,(intern (format "tramp-file-name-%s" elem))
- ,(or var 'v))))
- `,(tramp-compat-tramp-file-name-slots))))
+ (mapcar
+ (lambda (elem)
+ `(,(if var (intern (format "%s-%s" var elem)) elem)
+ (,(intern (format "tramp-file-name-%s" elem))
+ ,(or var 'v))))
+ (cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name))))))
`(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
,@bindings)
;; We don't know which of those vars will be used, so we bind them all,
@@ -1987,8 +2002,6 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
(ignore ,@(mapcar #'car bindings))
,@body)))
-(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
-(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
(defun tramp-progress-reporter-update (reporter &optional value suffix)
@@ -1999,25 +2012,30 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
(tramp-compat-progress-reporter-update reporter value suffix))))
(defmacro with-tramp-progress-reporter (vec level message &rest body)
- "Execute BODY, spinning a progress reporter with MESSAGE.
+ "Execute BODY, spinning a progress reporter with MESSAGE in interactive mode.
If LEVEL does not fit for visible messages, there are only traces
without a visible progress reporter."
(declare (indent 3) (debug t))
- `(progn
+ `(if (or noninteractive inhibit-message)
+ (progn ,@body)
(tramp-message ,vec ,level "%s..." ,message)
(let ((cookie "failed")
(tm
;; We start a pulsing progress reporter after 3 seconds.
- (when (and tramp-message-show-message
- ;; Display only when there is a minimum level.
- (<= ,level (min tramp-verbose 3)))
- (let ((pr (make-progress-reporter ,message nil nil)))
- (when pr
- (run-at-time
- 3 0.1 #'tramp-progress-reporter-update pr))))))
+ ;; Start only when there is no other progress reporter
+ ;; running, and when there is a minimum level.
+ (when-let ((pr (and (null tramp-inhibit-progress-reporter)
+ (<= ,level (min tramp-verbose 3))
+ (make-progress-reporter ,message nil nil))))
+ (run-at-time 3 0.1 #'tramp-progress-reporter-update pr))))
(unwind-protect
;; Execute the body.
- (prog1 (progn ,@body) (setq cookie "done"))
+ (prog1
+ ;; Suppress concurrent progress reporter messages.
+ (let ((tramp-inhibit-progress-reporter
+ (or tramp-inhibit-progress-reporter tm)))
+ ,@body)
+ (setq cookie "done"))
;; Stop progress reporter.
(if tm (cancel-timer tm))
(tramp-message ,vec ,level "%s...%s" ,message cookie)))))
@@ -2028,6 +2046,7 @@ without a visible progress reporter."
(defmacro with-tramp-file-property (vec file property &rest body)
"Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
FILE must be a local file name on a connection identified via VEC."
+ (declare (indent 3) (debug t))
`(if (file-name-absolute-p ,file)
(let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
(when (eq value 'undef)
@@ -2039,12 +2058,11 @@ FILE must be a local file name on a connection identified via VEC."
value)
,@body))
-(put 'with-tramp-file-property 'lisp-indent-function 3)
-(put 'with-tramp-file-property 'edebug-form-spec t)
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>"))
(defmacro with-tramp-connection-property (key property &rest body)
"Check in Tramp for property PROPERTY, otherwise execute BODY and set."
+ (declare (indent 2) (debug t))
`(let ((value (tramp-get-connection-property ,key ,property 'undef)))
(when (eq value 'undef)
;; We cannot pass ,@body as parameter to
@@ -2054,8 +2072,6 @@ FILE must be a local file name on a connection identified via VEC."
(tramp-set-connection-property ,key ,property value))
value))
-(put 'with-tramp-connection-property 'lisp-indent-function 2)
-(put 'with-tramp-connection-property 'edebug-form-spec t)
(font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-connection-property\\>"))
@@ -2068,12 +2084,15 @@ letter into the file name. This function removes it."
(save-match-data
(let ((quoted (tramp-compat-file-name-quoted-p name 'top))
(result (tramp-compat-file-name-unquote name 'top)))
- (setq result (if (string-match "\\`[a-zA-Z]:/" result)
+ (setq result (if (string-match "\\`[[:alpha:]]:/" result)
(replace-match "/" nil t result) result))
(if quoted (tramp-compat-file-name-quote result 'top) result))))
;;; Config Manipulation Functions:
+(defconst tramp-dns-sd-service-regexp "^_[-[:alnum:]]+\\._tcp$"
+ "DNS-SD service regexp.")
+
(defun tramp-set-completion-function (method function-list)
"Set the list of completion functions for METHOD.
FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
@@ -2106,10 +2125,10 @@ Example:
(zerop
(tramp-call-process
v "reg" nil nil nil "query" (nth 1 (car v))))))
- ;; Zeroconf service type.
+ ;; DNS-SD service type.
((string-match-p
- "^_[[:alpha:]]+\\._[[:alpha:]]+$" (nth 1 (car v))))
- ;; Configuration file.
+ tramp-dns-sd-service-regexp (nth 1 (car v))))
+ ;; Configuration file or empty string.
(t (file-exists-p (nth 1 (car v))))))
(setq r (delete (car v) r)))
(setq v (cdr v)))
@@ -2147,11 +2166,13 @@ For definition of that list see `tramp-set-completion-function'."
(defvar tramp-devices 0
"Keeps virtual device numbers.")
-(defun tramp-default-file-modes (filename)
+(defun tramp-default-file-modes (filename &optional flag)
"Return file modes of FILENAME as integer.
-If the file modes of FILENAME cannot be determined, return the
-value of `default-file-modes', without execute permissions."
- (or (file-modes filename)
+If optional FLAG is ‘nofollow’, do not follow FILENAME if it is a
+symbolic link. If the file modes of FILENAME cannot be
+determined, return the value of `default-file-modes', without
+execute permissions."
+ (or (tramp-compat-file-modes filename flag)
(logand (default-file-modes) #o0666)))
(defun tramp-replace-environment-variables (filename)
@@ -2182,6 +2203,7 @@ arguments to pass to the OPERATION."
tramp-vc-file-name-handler
tramp-completion-file-name-handler
tramp-archive-file-name-handler
+ tramp-crypt-file-name-handler
cygwin-mount-name-hook-function
cygwin-mount-map-drive-hook-function
.
@@ -2247,7 +2269,7 @@ Must be handled by the callers."
file-newer-than-file-p rename-file))
(cond
((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
- ((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
+ ((file-name-absolute-p (nth 1 args)) (nth 1 args))
(t default-directory)))
;; FILE DIRECTORY resp FILE1 FILE2.
((eq operation 'expand-file-name)
@@ -2275,13 +2297,13 @@ Must be handled by the callers."
exec-path make-process))
default-directory)
;; PROC.
- ((member operation
- '(file-notify-rm-watch
- ;; Emacs 25+ only.
- file-notify-valid-p))
+ ((member operation '(file-notify-rm-watch file-notify-valid-p))
(when (processp (nth 0 args))
(with-current-buffer (process-buffer (nth 0 args))
default-directory)))
+ ;; VEC.
+ ((member operation '(tramp-get-remote-gid tramp-get-remote-uid))
+ (tramp-make-tramp-file-name (nth 0 args)))
;; Unknown file primitive.
(t (error "Unknown file I/O primitive: %s" operation))))
@@ -2398,7 +2420,7 @@ Fall back to normal file name handler if no Tramp file name handler exists."
(cons operation args))
(tramp-run-real-handler operation args))
((eq result 'suppress)
- (let (tramp-message-show-message)
+ (let ((inhibit-message t))
(tramp-message
v 1 "Suppress received in operation %s"
(cons operation args))
@@ -2427,18 +2449,21 @@ Fall back to normal file name handler if no Tramp file name handler exists."
(defun tramp-completion-file-name-handler (operation &rest args)
"Invoke Tramp file name completion handler for OPERATION and ARGS.
Falls back to normal file name handler if no Tramp file name handler exists."
- (let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
- (if (and fn tramp-mode)
- (save-match-data (apply (cdr fn) args))
- (tramp-run-real-handler operation args))))
+ (if-let
+ ((fn (and tramp-mode
+ (assoc operation tramp-completion-file-name-handler-alist))))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
;;;###autoload
(progn (defun tramp-autoload-file-name-handler (operation &rest args)
"Load Tramp file name handler, and perform OPERATION."
(tramp-unload-file-name-handlers)
- (if tramp-mode
- (let ((default-directory temporary-file-directory))
- (load "tramp" 'noerror 'nomessage)))
+ (when tramp-mode
+ ;; We cannot use `tramp-compat-temporary-file-directory' here due
+ ;; to autoload.
+ (let ((default-directory temporary-file-directory))
+ (load "tramp" 'noerror 'nomessage)))
(apply operation args)))
;; `tramp-autoload-file-name-handler' must be registered before
@@ -2450,7 +2475,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(add-to-list 'file-name-handler-alist
(cons tramp-autoload-file-name-regexp
'tramp-autoload-file-name-handler))
- (put 'tramp-autoload-file-name-handler 'safe-magic t)))
+ (put #'tramp-autoload-file-name-handler 'safe-magic t)))
;;;###autoload (tramp-register-autoload-file-name-handlers)
@@ -2486,34 +2511,36 @@ remote file names."
(tramp-unload-file-name-handlers)
;; Add the handlers. We do not add anything to the `operations'
- ;; property of `tramp-file-name-handler' and
- ;; `tramp-archive-file-name-handler', this shall be done by the
+ ;; property of `tramp-file-name-handler',
+ ;; `tramp-archive-file-name-handler' and
+ ;; `tramp-crypt-file-name-handler', this shall be done by the
;; respective foreign handlers.
(add-to-list 'file-name-handler-alist
(cons tramp-file-name-regexp #'tramp-file-name-handler))
- (put 'tramp-file-name-handler 'safe-magic t)
+ (put #'tramp-file-name-handler 'safe-magic t)
+
+ (tramp-register-crypt-file-name-handler)
(add-to-list 'file-name-handler-alist
(cons tramp-completion-file-name-regexp
#'tramp-completion-file-name-handler))
- (put 'tramp-completion-file-name-handler 'safe-magic t)
+ (put #'tramp-completion-file-name-handler 'safe-magic t)
;; Mark `operations' the handler is responsible for.
- (put 'tramp-completion-file-name-handler 'operations
+ (put #'tramp-completion-file-name-handler 'operations
(mapcar #'car tramp-completion-file-name-handler-alist))
(when (bound-and-true-p tramp-archive-enabled)
(add-to-list 'file-name-handler-alist
(cons tramp-archive-file-name-regexp
#'tramp-archive-file-name-handler))
- (put 'tramp-archive-file-name-handler 'safe-magic t))
+ (put #'tramp-archive-file-name-handler 'safe-magic t))
;; If jka-compr or epa-file are already loaded, move them to the
;; front of `file-name-handler-alist'.
(dolist (fnh '(epa-file-handler jka-compr-handler))
- (let ((entry (rassoc fnh file-name-handler-alist)))
- (when entry
- (setq file-name-handler-alist
- (cons entry (delete entry file-name-handler-alist)))))))
+ (when-let ((entry (rassoc fnh file-name-handler-alist)))
+ (setq file-name-handler-alist
+ (cons entry (delete entry file-name-handler-alist))))))
(tramp--with-startup (tramp-register-file-name-handlers))
@@ -2525,7 +2552,7 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
(add-to-list
'tramp-foreign-file-name-handler-alist `(,func . ,handler) append)
;; Mark `operations' the handler is responsible for.
- (put 'tramp-file-name-handler
+ (put #'tramp-file-name-handler
'operations
(delete-dups
(append
@@ -2566,24 +2593,11 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
;;; File name handler functions for completion mode:
-;;;###autoload
-(defvar tramp-completion-mode nil
- "If non-nil, external packages signal that they are in file name completion.")
-(make-obsolete-variable 'tramp-completion-mode 'non-essential "26.1")
-
-(defun tramp-completion-mode-p ()
- "Check, whether method / user name / host name completion is active."
- (or
- ;; Signal from outside.
- non-essential
- ;; This variable has been obsoleted in Emacs 26.
- tramp-completion-mode))
-
(defun tramp-connectable-p (vec-or-filename)
"Check, whether it is possible to connect the remote host w/o side-effects.
This is true, if either the remote host is already connected, or if we are
not in completion mode."
- (let (tramp-verbose
+ (let ((tramp-verbose 0)
(vec
(cond
((tramp-file-name-p vec-or-filename) vec-or-filename)
@@ -2593,7 +2607,7 @@ not in completion mode."
;; `tramp-buffer-name'; otherwise `start-file-process'
;; wouldn't run ever when `non-essential' is non-nil.
(and vec (process-live-p (get-process (tramp-buffer-name vec))))
- (not (tramp-completion-mode-p)))))
+ (not non-essential))))
;; Method, host name and user name completion.
;; `tramp-completion-dissect-file-name' returns a list of
@@ -2884,7 +2898,7 @@ Either user or host may be nil."
(defun tramp-parse-rhosts-group ()
"Return a (user host) tuple allowed to access.
Either user or host may be nil."
- (let ((result)
+ (let (result
(regexp
(concat
"^\\(" tramp-host-regexp "\\)"
@@ -2934,7 +2948,7 @@ User is always nil."
"Return a list of (user host) tuples allowed to access.
User is always nil."
(tramp-parse-shostkeys-sknownhosts
- dirname (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$")))
+ dirname (concat "^key_[[:digit:]]+_\\(" tramp-host-regexp "\\)\\.pub$")))
(defun tramp-parse-sknownhosts (dirname)
"Return a list of (user host) tuples allowed to access.
@@ -2969,7 +2983,7 @@ Host is always \"localhost\"."
(defun tramp-parse-passwd-group ()
"Return a (user host) tuple allowed to access.
Host is always \"localhost\"."
- (let ((result)
+ (let (result
(regexp (concat "^\\(" tramp-user-regexp "\\):")))
(when (re-search-forward regexp (point-at-eol) t)
(setq result (list (match-string 1) "localhost")))
@@ -2991,7 +3005,7 @@ Host is always \"localhost\"."
(defun tramp-parse-etc-group-group ()
"Return a (group host) tuple allowed to access.
Host is always \"localhost\"."
- (let ((result)
+ (let (result
(split (split-string (buffer-substring (point) (point-at-eol)) ":")))
(when (member (user-login-name) (split-string (nth 3 split) "," 'omit))
(setq result (list (nth 0 split) "localhost")))
@@ -3028,7 +3042,7 @@ User is always nil."
(defun tramp-parse-putty-group (registry)
"Return a (user host) tuple allowed to access.
User is always nil."
- (let ((result)
+ (let (result
(regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
(when (re-search-forward regexp (point-at-eol) t)
(setq result (list nil (match-string 1))))
@@ -3102,8 +3116,7 @@ User is always nil."
(setq directory (substring directory 0 -1)))
directory)
-(defun tramp-handle-directory-files
- (directory &optional full match nosort _count)
+(defun tramp-handle-directory-files (directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
(unless (file-exists-p directory)
(tramp-error
@@ -3119,16 +3132,20 @@ User is always nil."
(when (or (null match) (string-match-p match item))
(push (if full (concat directory item) item)
result)))
- (if nosort result (sort result #'string<)))))
+ (unless nosort
+ (setq result (sort result #'string<)))
+ (when (and (natnump count) (> count 0))
+ (setq result (nbutlast result (- (length result) count))))
+ result)))
(defun tramp-handle-directory-files-and-attributes
- (directory &optional full match nosort id-format _count)
+ (directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
(mapcar
(lambda (x)
(cons x (file-attributes
(if full x (expand-file-name x directory)) id-format)))
- (directory-files directory full match nosort)))
+ (tramp-compat-directory-files directory full match nosort count)))
(defun tramp-handle-dired-uncache (dir)
"Like `dired-uncache' for Tramp files."
@@ -3208,12 +3225,13 @@ User is always nil."
(copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
tmpfile)))
-(defun tramp-handle-file-modes (filename &optional _flag)
+(defun tramp-handle-file-modes (filename &optional flag)
"Like `file-modes' for Tramp files."
- ;; Starting with Emacs 25.1, `when-let' can be used.
- (let ((attrs (file-attributes (or (file-truename filename) filename))))
- (when attrs
- (tramp-mode-string-to-int (tramp-compat-file-attribute-modes attrs)))))
+ (when-let ((attrs (file-attributes filename))
+ (mode-string (tramp-compat-file-attribute-modes attrs)))
+ (if (and (not (eq flag 'nofollow)) (eq ?l (aref mode-string 0)))
+ (file-modes (file-truename filename))
+ (tramp-mode-string-to-int mode-string))))
;; Localname manipulation functions that grok Tramp localnames...
(defun tramp-handle-file-name-as-directory (file)
@@ -3251,12 +3269,13 @@ User is always nil."
(let ((candidate
(tramp-compat-file-name-unquote
(directory-file-name filename)))
+ case-fold-search
tmpfile)
;; Check, whether we find an existing file with
;; lower case letters. This avoids us to create a
;; temporary file.
(while (and (string-match-p
- "[a-z]" (tramp-file-local-name candidate))
+ "[[:lower:]]" (tramp-file-local-name candidate))
(not (file-exists-p candidate)))
(setq candidate
(directory-file-name
@@ -3265,8 +3284,8 @@ User is always nil."
;; for comparison. `make-nearby-temp-file' is added
;; to Emacs 26+ like `file-name-case-insensitive-p',
;; so there is no compatibility problem calling it.
- (unless
- (string-match-p "[a-z]" (tramp-file-local-name candidate))
+ (unless (string-match-p
+ "[[:lower:]]" (tramp-file-local-name candidate))
(setq tmpfile
(let ((default-directory
(file-name-directory filename)))
@@ -3331,21 +3350,18 @@ User is always nil."
(cond
((not (file-exists-p file1)) nil)
((not (file-exists-p file2)) t)
- (t (time-less-p (tramp-compat-file-attribute-modification-time
- (file-attributes file2))
- (tramp-compat-file-attribute-modification-time
- (file-attributes file1))))))
+ (t (time-less-p
+ (tramp-compat-file-attribute-modification-time (file-attributes file2))
+ (tramp-compat-file-attribute-modification-time
+ (file-attributes file1))))))
(defun tramp-handle-file-regular-p (filename)
"Like `file-regular-p' for Tramp files."
(and (file-exists-p filename)
;; Sometimes, `file-attributes' does not return a proper value
;; even if `file-exists-p' does.
- (ignore-errors
- (eq ?-
- (aref
- (tramp-compat-file-attribute-modes (file-attributes filename))
- 0)))))
+ (when-let ((attr (file-attributes filename)))
+ (eq ?- (aref (tramp-compat-file-attribute-modes attr) 0)))))
(defun tramp-handle-file-remote-p (filename &optional identification connected)
"Like `file-remote-p' for Tramp files."
@@ -3384,8 +3400,7 @@ User is always nil."
"Like `file-truename' for Tramp files."
;; Preserve trailing "/".
(funcall
- (if (tramp-compat-directory-name-p filename)
- #'file-name-as-directory #'identity)
+ (if (directory-name-p filename) #'file-name-as-directory #'identity)
;; Quote properly.
(funcall
(if (tramp-compat-file-name-quoted-p filename)
@@ -3397,6 +3412,8 @@ User is always nil."
;; something is wrong; otherwise they might think that Emacs
;; is hung. Of course, correctness has to come first.
(numchase-limit 20)
+ ;; Unquoting could enable encryption.
+ tramp-crypt-enabled
symlink-target)
(with-parsed-tramp-file-name result v1
;; We cache only the localname.
@@ -3456,7 +3473,7 @@ User is always nil."
"Like `insert-directory' for Tramp files."
(unless switches (setq switches ""))
;; Mark trailing "/".
- (when (and (tramp-compat-directory-name-p filename)
+ (when (and (directory-name-p filename)
(not full-directory-p))
(setq switches (concat switches "F")))
;; Check, whether directory is accessible.
@@ -3466,7 +3483,7 @@ User is always nil."
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
(let (ls-lisp-use-insert-directory-program start)
;; Silence byte compiler.
- ls-lisp-use-insert-directory-program
+ (ignore ls-lisp-use-insert-directory-program)
(tramp-run-real-handler
#'insert-directory
(list filename switches wildcard full-directory-p))
@@ -3515,10 +3532,10 @@ User is always nil."
;; When we shall insert only a part of the file, we
;; copy this part. This works only for the shell file
- ;; name handlers.
+ ;; name handlers. It doesn't work for crypted files.
(when (and (or beg end)
- (tramp-get-method-parameter
- v 'tramp-login-program))
+ (tramp-sh-file-name-handler-p v)
+ (null tramp-crypt-enabled))
(setq remote-copy (tramp-make-tramp-temp-file v))
;; This is defined in tramp-sh.el. Let's assume
;; this is loaded already.
@@ -3590,8 +3607,8 @@ User is always nil."
;; Save exit.
(progn
(when visit
- (setq buffer-file-name filename)
- (setq buffer-read-only (not (file-writable-p filename)))
+ (setq buffer-file-name filename
+ buffer-read-only (not (file-writable-p filename)))
(set-visited-file-modtime)
(set-buffer-modified-p nil))
(when (and (stringp local-copy)
@@ -3625,7 +3642,8 @@ User is always nil."
v tramp-file-missing "Cannot load nonexistent file `%s'" file))
(if (not (file-exists-p file))
nil
- (let ((tramp-message-show-message (not nomessage)))
+ (let ((signal-hook-function (unless noerror signal-hook-function))
+ (inhibit-message (or inhibit-message nomessage)))
(with-tramp-progress-reporter v 0 (format "Loading %s" file)
(let ((local-copy (file-local-copy file)))
(unwind-protect
@@ -3633,8 +3651,224 @@ User is always nil."
(delete-file local-copy)))))
t)))
+(defun tramp-multi-hop-p (vec)
+ "Whether the method of VEC is capable of multi-hops."
+ (and (tramp-sh-file-name-handler-p vec)
+ (not (tramp-get-method-parameter vec 'tramp-copy-program))))
+
+(defun tramp-compute-multi-hops (vec)
+ "Expands VEC according to `tramp-default-proxies-alist'."
+ (let ((saved-tdpa tramp-default-proxies-alist)
+ (target-alist `(,vec))
+ (hops (or (tramp-file-name-hop vec) ""))
+ (item vec)
+ choices proxy)
+
+ ;; Ad-hoc proxy definitions.
+ (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
+ (let* ((host-port (tramp-file-name-host-port item))
+ (user-domain (tramp-file-name-user-domain item))
+ (proxy (concat
+ tramp-prefix-format proxy tramp-postfix-host-format))
+ (entry
+ (list (and (stringp host-port)
+ (concat "^" (regexp-quote host-port) "$"))
+ (and (stringp user-domain)
+ (concat "^" (regexp-quote user-domain) "$"))
+ (propertize proxy 'tramp-ad-hoc t))))
+ (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
+ ;; Add the hop.
+ (add-to-list 'tramp-default-proxies-alist entry)
+ (setq item (tramp-dissect-file-name proxy))))
+ ;; Save the new value.
+ (when (and hops tramp-save-ad-hoc-proxies)
+ (customize-save-variable
+ 'tramp-default-proxies-alist tramp-default-proxies-alist))
+
+ ;; Look for proxy hosts to be passed.
+ (setq choices tramp-default-proxies-alist)
+ (while choices
+ (setq item (pop choices)
+ proxy (eval (nth 2 item)))
+ (when (and
+ ;; Host.
+ (string-match-p
+ (or (eval (nth 0 item)) "")
+ (or (tramp-file-name-host-port (car target-alist)) ""))
+ ;; User.
+ (string-match-p
+ (or (eval (nth 1 item)) "")
+ (or (tramp-file-name-user-domain (car target-alist)) "")))
+ (if (null proxy)
+ ;; No more hops needed.
+ (setq choices nil)
+ ;; Replace placeholders.
+ (setq proxy
+ (format-spec
+ proxy
+ (format-spec-make
+ ?u (or (tramp-file-name-user (car target-alist)) "")
+ ?h (or (tramp-file-name-host (car target-alist)) ""))))
+ (with-parsed-tramp-file-name proxy l
+ ;; Add the hop.
+ (push l target-alist)
+ ;; Start next search.
+ (setq choices tramp-default-proxies-alist)))))
+
+ ;; Foreign and out-of-band methods are not supported for multi-hops.
+ (when (cdr target-alist)
+ (setq choices target-alist)
+ (while (setq item (pop choices))
+ (unless (tramp-multi-hop-p item)
+ (setq tramp-default-proxies-alist saved-tdpa)
+ (tramp-user-error
+ vec "Method `%s' is not supported for multi-hops."
+ (tramp-file-name-method item)))))
+
+ ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the
+ ;; host name in their command template. In this case, the remote
+ ;; file name must use either a local host name (first hop), or a
+ ;; host name matching the previous hop.
+ (let ((previous-host (or tramp-local-host-regexp "")))
+ (setq choices target-alist)
+ (while (setq item (pop choices))
+ (let ((host (tramp-file-name-host item)))
+ (unless
+ (or
+ ;; The host name is used for the remote shell command.
+ (member
+ '("%h") (tramp-get-method-parameter item 'tramp-login-args))
+ ;; The host name must match previous hop.
+ (string-match-p previous-host host))
+ (setq tramp-default-proxies-alist saved-tdpa)
+ (tramp-user-error
+ vec "Host name `%s' does not match `%s'" host previous-host))
+ (setq previous-host (concat "^" (regexp-quote host) "$")))))
+
+ ;; Result.
+ target-alist))
+
+(defun tramp-direct-async-process-p (&rest args)
+ "Whether direct async `make-process' can be called."
+ (let ((v (tramp-dissect-file-name default-directory))
+ (buffer (plist-get args :buffer))
+ (stderr (plist-get args :stderr)))
+ (and ;; It has been indicated.
+ (tramp-get-connection-property v "direct-async-process" nil)
+ ;; There's no multi-hop.
+ (or (not (tramp-multi-hop-p v))
+ (= (length (tramp-compute-multi-hops v)) 1))
+ ;; There's no remote stdout or stderr file.
+ (or (not (stringp buffer)) (not (tramp-tramp-file-p buffer)))
+ (or (not (stringp stderr)) (not (tramp-tramp-file-p stderr))))))
+
+(defun tramp-handle-make-process (&rest args)
+ "An alternative `make-process' implementation for Tramp files.
+It does not support `:stderr'."
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((default-directory (tramp-compat-temporary-file-directory))
+ (name (plist-get args :name))
+ (buffer (plist-get args :buffer))
+ (command (plist-get args :command))
+ (coding (plist-get args :coding))
+ (noquery (plist-get args :noquery))
+ (connection-type (plist-get args :connection-type))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ (stderr (plist-get args :stderr)))
+ (unless (stringp name)
+ (signal 'wrong-type-argument (list #'stringp name)))
+ (unless (or (null buffer) (bufferp buffer) (stringp buffer))
+ (signal 'wrong-type-argument (list #'stringp buffer)))
+ (unless (consp command)
+ (signal 'wrong-type-argument (list #'consp command)))
+ (unless (or (null coding)
+ (and (symbolp coding) (memq coding coding-system-list))
+ (and (consp coding)
+ (memq (car coding) coding-system-list)
+ (memq (cdr coding) coding-system-list)))
+ (signal 'wrong-type-argument (list #'symbolp coding)))
+ (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (functionp filter))
+ (signal 'wrong-type-argument (list #'functionp filter)))
+ (unless (or (null sentinel) (functionp sentinel))
+ (signal 'wrong-type-argument (list #'functionp sentinel)))
+ (unless (or (null stderr) (bufferp stderr))
+ (signal 'wrong-type-argument (list #'stringp stderr)))
+
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ (command
+ (mapconcat
+ #'identity (append `("cd" ,localname "&&") command) " ")))
+
+ ;; Check for `tramp-sh-file-name-handler', because something
+ ;; is different between tramp-adb.el and tramp-sh.el.
+ (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v))
+ (login-program
+ (tramp-get-method-parameter v 'tramp-login-program))
+ (login-args
+ (tramp-get-method-parameter v 'tramp-login-args))
+ (async-args
+ (tramp-get-method-parameter v 'tramp-async-args))
+ (direct-async-args
+ (tramp-get-method-parameter v 'tramp-direct-async-args))
+ ;; We don't create the temporary file. In fact, it
+ ;; is just a prefix for the ControlPath option of
+ ;; ssh; the real temporary file has another name, and
+ ;; it is created and protected by ssh. It is also
+ ;; removed by ssh when the connection is closed. The
+ ;; temporary file name is cached in the main
+ ;; connection process, therefore we cannot use
+ ;; `tramp-get-connection-process'.
+ (tmpfile
+ (when sh-file-name-handler-p
+ (with-tramp-connection-property
+ (tramp-get-process v) "temp-file"
+ (tramp-compat-make-temp-name))))
+ (options
+ (when sh-file-name-handler-p
+ (tramp-compat-funcall
+ 'tramp-ssh-controlmaster-options v)))
+ spec p)
+
+ ;; Replace `login-args' place holders.
+ (setq
+ spec (format-spec-make ?t tmpfile)
+ options (format-spec (or options "") spec)
+ spec (format-spec-make
+ ?h (or host "") ?u (or user "") ?p (or port "")
+ ?c options ?l "")
+ ;; Add arguments for asynchronous processes.
+ login-args (append async-args direct-async-args login-args)
+ ;; Expand format spec.
+ login-args
+ (tramp-compat-flatten-tree
+ (mapcar
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) x))
+ login-args))
+ ;; Split ControlMaster options.
+ login-args
+ (tramp-compat-flatten-tree
+ (mapcar (lambda (x) (split-string x " ")) login-args))
+ p (make-process
+ :name name :buffer buffer
+ :command (append `(,login-program) login-args `(,command))
+ :coding coding :noquery noquery :connection-type connection-type
+ :filter filter :sentinel sentinel :stderr stderr))
+
+ (tramp-message v 6 "%s" (string-join (process-command p) " "))
+ p))))))
+
(defun tramp-handle-make-symbolic-link
- (target linkname &optional ok-if-already-exists)
+ (target linkname &optional ok-if-already-exists)
"Like `make-symbolic-link' for Tramp files.
This is the fallback implementation for backends which do not
support symbolic links."
@@ -3647,8 +3881,7 @@ support symbolic links."
(tramp-run-real-handler
#'make-symbolic-link (list target linkname ok-if-already-exists))))
-(defun tramp-handle-shell-command
- (command &optional output-buffer error-buffer)
+(defun tramp-handle-shell-command (command &optional output-buffer error-buffer)
"Like `shell-command' for Tramp files."
(let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command))
(command (substring command 0 asynchronous))
@@ -3667,9 +3900,12 @@ support symbolic links."
(setq current-buffer-p t)
(current-buffer))
(t (get-buffer-create
+ ;; These variables have been introduced with Emacs 28.1.
(if asynchronous
- "*Async Shell Command*"
- "*Shell Command Output*")))))
+ (or (bound-and-true-p shell-command-buffer-name-async)
+ "*Async Shell Command*")
+ (or (bound-and-true-p shell-command-buffer-name)
+ "*Shell Command Output*"))))))
(error-buffer
(cond
((bufferp error-buffer) error-buffer)
@@ -3803,7 +4039,8 @@ support symbolic links."
(defun tramp-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files.
BUFFER might be a list, in this case STDERR is separated."
- ;; `make-process' knows the `:file-handler' argument since Emacs 27.1 only.
+ ;; `make-process' knows the `:file-handler' argument since Emacs
+ ;; 27.1 only. Therefore, we invoke it via `tramp-file-name-handler'.
(tramp-file-name-handler
'make-process
:name name
@@ -3911,7 +4148,14 @@ of."
(tramp-error v 'file-already-exists filename))
(let ((tmpfile (tramp-compat-make-temp-file filename))
- (modes (save-excursion (tramp-default-file-modes filename))))
+ (modes (tramp-default-file-modes
+ filename (and (eq mustbenew 'excl) 'nofollow)))
+ (uid (or (tramp-compat-file-attribute-user-id
+ (file-attributes filename 'integer))
+ (tramp-get-remote-uid v 'integer)))
+ (gid (or (tramp-compat-file-attribute-group-id
+ (file-attributes filename 'integer))
+ (tramp-get-remote-gid v 'integer))))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; The permissions of the temporary file should be set. If
@@ -3930,15 +4174,19 @@ of."
(error
(delete-file tmpfile)
(tramp-error
- v 'file-error "Couldn't write region to `%s'" filename))))
+ v 'file-error "Couldn't write region to `%s'" filename)))
- (tramp-flush-file-properties v localname)
+ (tramp-flush-file-properties v localname)
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))))
+ ;; Set file modification time.
+ (when (or (eq visit t) (stringp visit))
+ (set-visited-file-modtime
+ (or (tramp-compat-file-attribute-modification-time
+ (file-attributes filename))
+ (current-time))))
+
+ ;; Set the ownership.
+ (tramp-set-file-uid-gid filename uid gid))
;; The end.
(when (and (null noninteractive)
@@ -3992,7 +4240,7 @@ of."
"Call `file-notify-rm-watch'."
(unless (process-live-p proc)
(tramp-message proc 5 "Sentinel called: `%S' `%s'" proc event)
- (tramp-compat-funcall 'file-notify-rm-watch proc)))
+ (file-notify-rm-watch proc)))
;;; Functions for establishing connection:
@@ -4134,9 +4382,9 @@ See `tramp-process-actions' for the format of ACTIONS."
(while (tramp-accept-process-output proc 0))
(setq todo actions)
(while todo
- (setq item (pop todo))
- (setq pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))))
- (setq action (nth 1 item))
+ (setq item (pop todo)
+ pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item)))
+ action (nth 1 item))
(tramp-message
vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
(when (tramp-check-for-regexp proc pattern)
@@ -4186,9 +4434,8 @@ performed successfully. Any other value means an error."
(catch 'tramp-action
(tramp-process-one-action proc vec actions)))))
(while (not exit)
- (setq exit
- (catch 'tramp-action
- (tramp-process-one-action proc vec actions)))))
+ (setq exit (catch 'tramp-action
+ (tramp-process-one-action proc vec actions)))))
(with-current-buffer (tramp-get-connection-buffer vec)
(widen)
(tramp-message vec 6 "\n%s" (buffer-string)))
@@ -4209,10 +4456,9 @@ performed successfully. Any other value means an error."
(tramp-get-connection-buffer vec)))
((eq exit 'process-died)
(substitute-command-keys
- (eval-when-compile
- (concat
- "Tramp failed to connect. If this happens repeatedly, try\n"
- " `\\[tramp-cleanup-this-connection]'"))))
+ (concat
+ "Tramp failed to connect. If this happens repeatedly, try\n"
+ " `\\[tramp-cleanup-this-connection]'")))
((eq exit 'timeout)
(format-message
"Timeout reached, see buffer `%s' for details"
@@ -4227,18 +4473,21 @@ performed successfully. Any other value means an error."
(defun tramp-accept-process-output (proc &optional timeout)
"Like `accept-process-output' for Tramp processes.
This is needed in order to hide `last-coding-system-used', which is set
-for process communication also."
+for process communication also.
+If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'."
(with-current-buffer (process-buffer proc)
(let ((inhibit-read-only t)
last-coding-system-used
result)
- ;; JUST-THIS-ONE is set due to Bug#12145.
- (tramp-message
- proc 10 "%s %s %s %s\n%s"
- proc timeout (process-status proc)
- (with-local-quit
- (setq result (accept-process-output proc timeout nil t)))
- (buffer-string))
+ ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit'
+ ;; returns t in order to report success.
+ (if (with-local-quit
+ (setq result (accept-process-output proc timeout nil t)) t)
+ (tramp-message
+ proc 10 "%s %s %s %s\n%s"
+ proc timeout (process-status proc) result (buffer-string))
+ ;; Propagate quit.
+ (keyboard-quit))
result)))
(defun tramp-search-regexp (regexp)
@@ -4396,7 +4645,7 @@ If it doesn't exist, generate a new one."
(with-tramp-connection-property (tramp-get-connection-process vec) "device"
(cons -1 (setq tramp-devices (1+ tramp-devices)))))
-;; Comparision of vectors is performed by `tramp-file-name-equal-p'.
+;; Comparison of vectors is performed by `tramp-file-name-equal-p'.
(defun tramp-equal-remote (file1 file2)
"Check, whether the remote parts of FILE1 and FILE2 are identical.
The check depends on method, user and host name of the files. If
@@ -4417,6 +4666,7 @@ If both files are local, the function returns t."
(and (tramp-tramp-file-p file1) (tramp-tramp-file-p file2)
(string-equal (file-remote-p file1) (file-remote-p file2)))))
+;; See also `file-modes-symbolic-to-number'.
(defun tramp-mode-string-to-int (mode-string)
"Convert a ten-letter \"drwxrwxrwx\"-style MODE-STRING into mode bits."
(let* (case-fold-search
@@ -4496,6 +4746,7 @@ If both files are local, the function returns t."
"A list of file types returned from the `stat' system call.
This is used to map a mode number to a permission string.")
+;; See also `file-modes-number-to-symbolic'.
(defun tramp-file-mode-from-int (mode)
"Turn an integer representing a file MODE into an ls(1)-like string."
(let ((type (cdr
@@ -4506,9 +4757,9 @@ This is used to map a mode number to a permission string.")
(suid (> (logand (ash mode -9) 4) 0))
(sgid (> (logand (ash mode -9) 2) 0))
(sticky (> (logand (ash mode -9) 1) 0)))
- (setq user (tramp-file-mode-permissions user suid "s"))
- (setq group (tramp-file-mode-permissions group sgid "s"))
- (setq other (tramp-file-mode-permissions other sticky "t"))
+ (setq user (tramp-file-mode-permissions user suid "s")
+ group (tramp-file-mode-permissions group sgid "s")
+ other (tramp-file-mode-permissions other sticky "t"))
(concat type user group other)))
(defun tramp-file-mode-permissions (perm suid suid-text)
@@ -4538,16 +4789,15 @@ If FILENAME is remote, a file name handler is called."
(when (and modes (not (zerop (logand modes #o2000))))
(setq gid (tramp-compat-file-attribute-group-id (file-attributes dir)))))
- (let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid)))
- (if handler
- (funcall handler #'tramp-set-file-uid-gid filename uid gid)
- ;; On W32 systems, "chown" does not work.
- (unless (memq system-type '(ms-dos windows-nt))
- (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
- (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer))))
- (tramp-call-process
- nil "chown" nil nil nil (format "%d:%d" uid gid)
- (tramp-unquote-shell-quote-argument filename)))))))
+ (if-let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid)))
+ (funcall handler #'tramp-set-file-uid-gid filename uid gid)
+ ;; On W32 systems, "chown" does not work.
+ (unless (memq system-type '(ms-dos windows-nt))
+ (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
+ (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer))))
+ (tramp-call-process
+ nil "chown" nil nil nil (format "%d:%d" uid gid)
+ (tramp-unquote-shell-quote-argument filename))))))
(defun tramp-get-local-uid (id-format)
"The uid of the local user, in ID-FORMAT.
@@ -4613,12 +4863,8 @@ be granted."
(concat "file-attributes-" suffix) nil)
(file-attributes
(tramp-make-tramp-file-name vec) (intern suffix))))
- (remote-uid
- (tramp-get-connection-property
- vec (concat "uid-" suffix) nil))
- (remote-gid
- (tramp-get-connection-property
- vec (concat "gid-" suffix) nil))
+ (remote-uid (tramp-get-remote-uid vec (intern suffix)))
+ (remote-gid (tramp-get-remote-gid vec (intern suffix)))
(unknown-id
(if (string-equal suffix "string")
tramp-unknown-id-string tramp-unknown-id-integer)))
@@ -4652,6 +4898,32 @@ be granted."
(tramp-compat-file-attribute-group-id
file-attr))))))))))))
+(defun tramp-get-remote-uid (vec id-format)
+ "The uid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (with-tramp-connection-property vec (format "uid-%s" id-format)
+ (or (when-let
+ ((handler
+ (find-file-name-handler
+ (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid)))
+ (funcall handler #'tramp-get-remote-uid vec id-format))
+ ;; Ensure there is a valid result.
+ (and (equal id-format 'integer) tramp-unknown-id-integer)
+ (and (equal id-format 'string) tramp-unknown-id-string))))
+
+(defun tramp-get-remote-gid (vec id-format)
+ "The gid of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (with-tramp-connection-property vec (format "gid-%s" id-format)
+ (or (when-let
+ ((handler
+ (find-file-name-handler
+ (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid)))
+ (funcall handler #'tramp-get-remote-gid vec id-format))
+ ;; Ensure there is a valid result.
+ (and (equal id-format 'integer) tramp-unknown-id-integer)
+ (and (equal id-format 'string) tramp-unknown-id-string))))
+
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise.
This handles also chrooted environments, which are not regarded as local."
@@ -4665,16 +4937,16 @@ This handles also chrooted environments, which are not regarded as local."
;; The method shall be applied to one of the shell file name
;; handlers. `tramp-local-host-p' is also called for "smb" and
;; alike, where it must fail.
- (tramp-get-method-parameter vec 'tramp-login-program)
+ (tramp-sh-file-name-handler-p vec)
+ ;; Direct actions aren't possible for crypted directories.
+ (null tramp-crypt-enabled)
;; The local temp directory must be writable for the other user.
(file-writable-p
(tramp-make-tramp-file-name
vec (tramp-compat-temporary-file-directory) 'nohop))
;; On some systems, chown runs only for root.
(or (zerop (user-uid))
- ;; This is defined in tramp-sh.el. Let's assume this is
- ;; loaded already.
- (zerop (tramp-compat-funcall 'tramp-get-remote-uid vec 'integer))))))
+ (zerop (tramp-get-remote-uid vec 'integer))))))
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
@@ -4687,18 +4959,21 @@ This handles also chrooted environments, which are not regarded as local."
(tramp-error vec 'file-error "Directory %s not accessible" dir))
dir)))
+(defun tramp-make-tramp-temp-name (vec)
+ "Generate a temporary file name on the remote host identified by VEC."
+ (make-temp-name
+ (expand-file-name tramp-temp-name-prefix (tramp-get-remote-tmpdir vec))))
+
(defun tramp-make-tramp-temp-file (vec)
"Create a temporary file on the remote host identified by VEC.
Return the local name of the temporary file."
- (let ((prefix (expand-file-name
- tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))
- result)
+ (let (result)
(while (not result)
;; `make-temp-file' would be the natural choice for
;; implementation. But it calls `write-region' internally,
;; which also needs a temporary file - we would end in an
;; infinite loop.
- (setq result (make-temp-name prefix))
+ (setq result (tramp-make-tramp-temp-name vec))
(if (file-exists-p result)
(setq result nil)
;; This creates the file by side effect.
@@ -4871,6 +5146,19 @@ verbosity of 6."
(tramp-message vec 6 "%s" result)
result))
+(defun tramp-process-running-p (process-name)
+ "Return t if system process PROCESS-NAME is running for `user-login-name'."
+ (when (stringp process-name)
+ (catch 'result
+ (dolist (pid (list-system-processes))
+ (when-let ((attributes (process-attributes pid))
+ (comm (cdr (assoc 'comm attributes))))
+ (and (string-equal (cdr (assoc 'user attributes)) (user-login-name))
+ ;; The returned command name could be truncated to 15
+ ;; characters. Therefore, we cannot check for `string-equal'.
+ (string-prefix-p comm process-name)
+ (throw 'result t)))))))
+
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
Consults the auth-source package.
@@ -5051,6 +5339,23 @@ name of a process or buffer, or nil to default to the current buffer."
(lambda ()
(remove-hook 'interrupt-process-functions #'tramp-interrupt-process))))
+(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body)
+ "Skeleton for `tramp-*-handle-delete-directory'.
+BODY is the backend specific code."
+ (declare (indent 3) (debug t))
+ `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
+ (if (and delete-by-moving-to-trash ,trash)
+ ;; Move non-empty dir to trash only if recursive deletion was
+ ;; requested.
+ (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
+ (tramp-error
+ v 'file-error "Directory is not empty, not moving to trash")
+ (move-file-to-trash ,directory))
+ ,@body)
+ (tramp-flush-directory-properties v localname)))
+
+(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t)
+
;; Checklist for `tramp-unload-hook'
;; - Unload all `tramp-*' packages
;; - Reset `file-name-handler-alist'
@@ -5092,16 +5397,5 @@ name of a process or buffer, or nil to default to the current buffer."
;; and friends, for most of the handlers this is the major
;; difference between the different backends. Other handlers but
;; *-process-file would profit from this as well.
-;;
-;; * Get rid of `shell-command'. In its primary implementation, it
-;; uses `process-file-shell-command' and
-;; `start-file-process-shell-command', which is sufficient due to
-;; connection-local `shell-file-name'.
-
;;; tramp.el ends here
-
-;; Local Variables:
-;; mode: Emacs-Lisp
-;; coding: utf-8
-;; End:
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 4aed8abd9b3..8d21133b3b1 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -35,11 +35,8 @@
;; Emacs version check is defined in macro AC_EMACS_INFO of
;; aclocal.m4; should be changed only there.
-;; Needed for Emacs 24.
-(defvar inhibit-message)
-
;;;###tramp-autoload
-(defconst tramp-version "2.4.5-pre"
+(defconst tramp-version "2.5.0-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -73,9 +70,9 @@
"The repository revision of the Tramp sources.")
;; Check for Emacs version.
-(let ((x (if (not (string-lessp emacs-version "24.4"))
+(let ((x (if (not (string-lessp emacs-version "25.1"))
"ok"
- (format "Tramp 2.4.5-pre is not fit for %s"
+ (format "Tramp 2.5.0-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
@@ -104,8 +101,3 @@
(provide 'trampver)
;;; trampver.el ends here
-
-;; Local Variables:
-;; mode: Emacs-Lisp
-;; coding: utf-8
-;; End:
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index 6edd03c39cc..9fbc434760c 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -1,4 +1,4 @@
-;;; webjump.el --- programmable Web hotlist
+;;; webjump.el --- programmable Web hotlist -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc.
@@ -40,7 +40,6 @@
;; You may wish to add something like the following to your init file:
;;
-;; (require 'webjump)
;; (global-set-key "\C-cj" 'webjump)
;; (setq webjump-sites
;; (append '(
@@ -323,8 +322,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke
(defun webjump-read-url-choice (what urls &optional default)
;; Note: Convert this to use `webjump-read-choice' someday.
- (let* ((completions (mapcar (function (lambda (n) (cons n n)))
- urls))
+ (let* ((completions (mapcar (lambda (n) (cons n n)) urls))
(input (completing-read (concat what
;;(if default " (RET for default)" "")
": ")
diff --git a/lisp/notifications.el b/lisp/notifications.el
index 3c2a8cf39c0..f83898622ec 100644
--- a/lisp/notifications.el
+++ b/lisp/notifications.el
@@ -23,7 +23,7 @@
;;; Commentary:
;; This package provides an implementation of the Desktop Notifications
-;; <http://developer.gnome.org/notification-spec/>.
+;; <https://developer.gnome.org/notification-spec/>.
;; In order to activate this package, you must add the following code
;; into your .emacs:
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 644de03cf4c..5bb904e6915 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -2230,7 +2230,7 @@ ENDP is t in the former case, nil in the latter."
(skip-line-prefix fill-prefix)
fill-prefix))
-(defun nxml-newline-and-indent (soft)
+(defun nxml-newline-and-indent (&optional soft)
(delete-horizontal-space)
(if soft (insert-and-inherit ?\n) (newline 1))
(nxml-indent-line))
diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el
index f5bdf79349a..622ba911995 100644
--- a/lisp/nxml/xsd-regexp.el
+++ b/lisp/nxml/xsd-regexp.el
@@ -24,7 +24,7 @@
;; This handles the regular expressions in the syntax defined by:
;; W3C XML Schema Part 2: Datatypes
-;; <http://www.w3.org/TR/xmlschema-2/#regexs>
+;; <https://www.w3.org/TR/xmlschema-2/#regexs>
;;
;; The main entry point is `xsdre-translate'.
;;
@@ -1219,7 +1219,7 @@ Code is inserted into the current buffer."
;; The rest of the file was auto-generated by doing M-x xsdre-gen-categories
;; on UnicodeData-3.1.0.txt available from
-;; http://www.unicode.org/Public/3.1-Update/UnicodeData-3.1.0.txt
+;; https://www.unicode.org/Public/3.1-Update/UnicodeData-3.1.0.txt
(xsdre-def-primitive-category 'Lu
'((65 . 90)
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
index bf16fb25cd0..b1448e72e86 100644
--- a/lisp/obsolete/complete.el
+++ b/lisp/obsolete/complete.el
@@ -431,6 +431,8 @@ of `minibuffer-completion-table' and the minibuffer contents.")
(let ((result (try-completion string alist predicate)))
(if (eq result t) string result)))
+(defvar completion-base-size)
+
;; TODO document MODE magic...
(defun PC-do-completion (&optional mode beg end goto-end)
"Internal function to do the work of partial completion.
diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el
index fbf80692037..40532ea5b9d 100644
--- a/lisp/obsolete/cust-print.el
+++ b/lisp/obsolete/cust-print.el
@@ -156,10 +156,7 @@ If nil, printing proceeds recursively and may lead to
If non-nil, shared substructures anywhere in the structure are printed
with `#N=' before the first occurrence (in the order of the print
representation) and `#N#' in place of each subsequent occurrence,
-where N is a positive decimal integer.
-
-There is no way to read this representation in standard Emacs,
-but if you need to do so, try the cl-read.el package."
+where N is a positive decimal integer."
:type 'boolean
:group 'cust-print)
diff --git a/lisp/erc/erc-compat.el b/lisp/obsolete/erc-compat.el
index c77d5abf2e4..7ef30d822ff 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/obsolete/erc-compat.el
@@ -5,6 +5,7 @@
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; URL: https://www.emacswiki.org/emacs/ERC
+;; Obsolete-since: 28.1
;; This file is part of GNU Emacs.
@@ -43,12 +44,12 @@ Return the same string, if the encoding operation is trivial.
See `erc-encoding-coding-alist'."
(encode-coding-string s coding-system t))
-(defalias 'erc-propertize 'propertize)
-(defalias 'erc-view-mode-enter 'view-mode-enter)
+(define-obsolete-function-alias 'erc-propertize #'propertize "28.1")
+(define-obsolete-function-alias 'erc-view-mode-enter #'view-mode-enter "28.1")
(autoload 'help-function-arglist "help-fns")
-(defalias 'erc-function-arglist 'help-function-arglist)
-(defalias 'erc-delete-dups 'delete-dups)
-(defalias 'erc-replace-regexp-in-string 'replace-regexp-in-string)
+(define-obsolete-function-alias 'erc-function-arglist #'help-function-arglist "28.1")
+(define-obsolete-function-alias 'erc-delete-dups #'delete-dups "28.1")
+(define-obsolete-function-alias 'erc-replace-regexp-in-string #'replace-regexp-in-string "28.1")
(defun erc-set-write-file-functions (new-val)
(set (make-local-variable 'write-file-functions) new-val))
@@ -79,10 +80,12 @@ START is the beginning position of the last match (see `match-beginning').
See `replace-match' for explanations of FIXEDCASE and LITERAL."
(replace-match newtext fixedcase literal string subexp))
-(defalias 'erc-with-selected-window 'with-selected-window)
-(defalias 'erc-cancel-timer 'cancel-timer)
-(defalias 'erc-make-obsolete 'make-obsolete)
-(defalias 'erc-make-obsolete-variable 'make-obsolete-variable)
+(define-obsolete-function-alias 'erc-with-selected-window
+ #'with-selected-window "28.1")
+(define-obsolete-function-alias 'erc-cancel-timer #'cancel-timer "28.1")
+(define-obsolete-function-alias 'erc-make-obsolete #'make-obsolete "28.1")
+(define-obsolete-function-alias 'erc-make-obsolete-variable
+ #'make-obsolete-variable "28.1")
;; Provide a simpler replacement for `member-if'
(defun erc-member-if (predicate list)
diff --git a/lisp/obsolete/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el
index 8f554282aed..cd26edeaa24 100644
--- a/lisp/obsolete/erc-hecomplete.el
+++ b/lisp/obsolete/erc-hecomplete.el
@@ -4,7 +4,7 @@
;; Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion
+;; URL: https://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion
;; Obsolete-since: 24.1
;; This file is part of GNU Emacs.
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index 350eabdb0c1..96b063be701 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -1393,7 +1393,7 @@ Copied from `icomplete-tidy'."
"Move the summaries to the end of the list.
This is an example function which can be hooked on to
`iswitchb-make-buflist-hook'. Any buffer matching the regexps
-`Summary' or `output\*$'are put to the end of the list."
+`Summary' or `output\\*$'are put to the end of the list."
(let ((summaries (delq nil
(mapcar
(lambda (x)
diff --git a/lisp/obsolete/ledit.el b/lisp/obsolete/ledit.el
deleted file mode 100644
index c99a06de570..00000000000
--- a/lisp/obsolete/ledit.el
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; ledit.el --- Emacs side of ledit interface
-
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: languages
-;; Obsolete-since: 24.3
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This is a major mode for editing Liszt.
-
-;;; Code:
-
-;;; To do:
-;;; o lisp -> emacs side of things (grind-definition and find-definition)
-
-(defvar ledit-mode-map nil)
-
-(defconst ledit-zap-file
- (expand-file-name (concat (user-login-name) ".l1") temporary-file-directory)
- "File name for data sent to Lisp by Ledit.")
-(defconst ledit-read-file
- (expand-file-name (concat (user-login-name) ".l2") temporary-file-directory)
- "File name for data sent to Ledit by Lisp.")
-(defconst ledit-compile-file
- (expand-file-name (concat (user-login-name) ".l4") temporary-file-directory)
- "File name for data sent to Lisp compiler by Ledit.")
-(defconst ledit-buffer "*LEDIT*"
- "Name of buffer in which Ledit accumulates data to send to Lisp.")
-
-;;;###autoload
-(defconst ledit-save-files t "\
-*Non-nil means Ledit should save files before transferring to Lisp.")
-;;;###autoload
-(defconst ledit-go-to-lisp-string "%?lisp" "\
-*Shell commands to execute to resume Lisp job.")
-;;;###autoload
-(defconst ledit-go-to-liszt-string "%?liszt" "\
-*Shell commands to execute to resume Lisp compiler job.")
-
-(defun ledit-save-defun ()
- "Save the current defun in the ledit buffer."
- (interactive)
- (save-excursion
- (end-of-defun)
- (let ((end (point)))
- (beginning-of-defun)
- (append-to-buffer ledit-buffer (point) end))
- (message "Current defun saved for Lisp")))
-
-(defun ledit-save-region (beg end)
- "Save the current region in the ledit buffer"
- (interactive "r")
- (append-to-buffer ledit-buffer beg end)
- (message "Region saved for Lisp"))
-
-(defun ledit-zap-defun-to-lisp ()
- "Carry the current defun to Lisp."
- (interactive)
- (ledit-save-defun)
- (ledit-go-to-lisp))
-
-(defun ledit-zap-defun-to-liszt ()
- "Carry the current defun to liszt."
- (interactive)
- (ledit-save-defun)
- (ledit-go-to-liszt))
-
-(defun ledit-zap-region-to-lisp (beg end)
- "Carry the current region to Lisp."
- (interactive "r")
- (ledit-save-region beg end)
- (ledit-go-to-lisp))
-
-(defun ledit-go-to-lisp ()
- "Suspend Emacs and restart a waiting Lisp job."
- (interactive)
- (if ledit-save-files
- (save-some-buffers))
- (if (get-buffer ledit-buffer)
- (with-current-buffer ledit-buffer
- (goto-char (point-min))
- (write-region (point-min) (point-max) ledit-zap-file)
- (erase-buffer)))
- (suspend-emacs ledit-go-to-lisp-string)
- (load ledit-read-file t t))
-
-(defun ledit-go-to-liszt ()
- "Suspend Emacs and restart a waiting Liszt job."
- (interactive)
- (if ledit-save-files
- (save-some-buffers))
- (if (get-buffer ledit-buffer)
- (with-current-buffer ledit-buffer
- (goto-char (point-min))
- (insert "(declare (macros t))\n")
- (write-region (point-min) (point-max) ledit-compile-file)
- (erase-buffer)))
- (suspend-emacs ledit-go-to-liszt-string)
- (load ledit-read-file t t))
-
-(defun ledit-setup ()
- "Set up key bindings for the Lisp/Emacs interface."
- (unless ledit-mode-map
- (setq ledit-mode-map (make-sparse-keymap))
- (set-keymap-parent ledit-mode-map lisp-mode-shared-map))
- (define-key ledit-mode-map "\e\^d" 'ledit-save-defun)
- (define-key ledit-mode-map "\e\^r" 'ledit-save-region)
- (define-key ledit-mode-map "\^xz" 'ledit-go-to-lisp)
- (define-key ledit-mode-map "\e\^c" 'ledit-go-to-liszt))
-
-(ledit-setup)
-
-;;;###autoload
-(defun ledit-mode ()
- "\\<ledit-mode-map>Major mode for editing text and stuffing it to a Lisp job.
-Like Lisp mode, plus these special commands:
- \\[ledit-save-defun] -- record defun at or after point
- for later transmission to Lisp job.
- \\[ledit-save-region] -- record region for later transmission to Lisp job.
- \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text.
- \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job
- and transmit saved text.
-
-\\{ledit-mode-map}
-To make Lisp mode automatically change to Ledit mode,
-do (setq lisp-mode-hook 'ledit-from-lisp-mode)"
- (interactive)
- (delay-mode-hooks (lisp-mode))
- (ledit-from-lisp-mode))
-
-;;;###autoload
-(defun ledit-from-lisp-mode ()
- (use-local-map ledit-mode-map)
- (setq mode-name "Ledit")
- (setq major-mode 'ledit-mode)
- (run-mode-hooks 'ledit-mode-hook))
-
-(provide 'ledit)
-
-;;; ledit.el ends here
diff --git a/lisp/obsolete/levents.el b/lisp/obsolete/levents.el
deleted file mode 100644
index 2ae1ca48d16..00000000000
--- a/lisp/obsolete/levents.el
+++ /dev/null
@@ -1,292 +0,0 @@
-;;; levents.el --- emulate the Lucid event data type and associated functions
-
-;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: emulations
-;; Obsolete-since: 23.2
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Things we cannot emulate in Lisp:
-;; It is not possible to emulate current-mouse-event as a variable,
-;; though it is not hard to obtain the data from (this-command-keys).
-
-;; We do not have a variable unread-command-event;
-;; instead, we have the more general unread-command-events.
-
-;; Our read-key-sequence and read-char are not precisely
-;; compatible with those in Lucid Emacs, but they should work ok.
-
-;;; Code:
-
-(defun next-command-event (event)
- (error "You must rewrite to use `read-command-event' instead of `next-command-event'"))
-
-(defun next-event (event)
- (error "You must rewrite to use `read-event' instead of `next-event'"))
-
-(defun dispatch-event (event)
- (error "`dispatch-event' not supported"))
-
-;; Make events of type eval, menu and timeout
-;; execute properly.
-
-(define-key global-map [menu] 'execute-eval-event)
-(define-key global-map [timeout] 'execute-eval-event)
-(define-key global-map [eval] 'execute-eval-event)
-
-(defun execute-eval-event (event)
- (interactive "e")
- (funcall (nth 1 event) (nth 2 event)))
-
-(put 'eval 'event-symbol-elements '(eval))
-(put 'menu 'event-symbol-elements '(eval))
-(put 'timeout 'event-symbol-elements '(eval))
-
-(defun allocate-event ()
- "Return an empty event structure.
-In this emulation, it returns nil."
- nil)
-
-(defun button-press-event-p (obj)
- "True if the argument is a mouse-button-press event object."
- (and (consp obj) (symbolp (car obj))
- (memq 'down (get (car obj) 'event-symbol-elements))))
-
-(defun button-release-event-p (obj)
- "True if the argument is a mouse-button-release event object."
- (and (consp obj) (symbolp (car obj))
- (or (memq 'click (get (car obj) 'event-symbol-elements))
- (memq 'drag (get (car obj) 'event-symbol-elements)))))
-
-(defun button-event-p (obj)
- "True if the argument is a mouse-button press or release event object."
- (and (consp obj) (symbolp (car obj))
- (or (memq 'click (get (car obj) 'event-symbol-elements))
- (memq 'down (get (car obj) 'event-symbol-elements))
- (memq 'drag (get (car obj) 'event-symbol-elements)))))
-
-(defun mouse-event-p (obj)
- "True if the argument is a mouse-button press or release event object."
- (and (consp obj) (symbolp (car obj))
- (or (eq (car obj) 'mouse-movement)
- (memq 'click (get (car obj) 'event-symbol-elements))
- (memq 'down (get (car obj) 'event-symbol-elements))
- (memq 'drag (get (car obj) 'event-symbol-elements)))))
-
-(defun character-to-event (ch &optional event)
- "Converts a numeric ASCII value to an event structure, replete with
-bucky bits. The character is the first argument, and the event to fill
-in is the second. This function contains knowledge about what the codes
-mean -- for example, the number 9 is converted to the character Tab,
-not the distinct character Control-I.
-
-Beware that character-to-event and event-to-character are not strictly
-inverse functions, since events contain much more information than the
-ASCII character set can encode."
- ch)
-
-(defun copy-event (event1 &optional event2)
- "Make a copy of the given event object.
-In this emulation, `copy-event' just returns its argument."
- event1)
-
-(defun deallocate-event (event)
- "Allow the given event structure to be reused.
-In actual Lucid Emacs, you MUST NOT use this event object after
-calling this function with it. You will lose. It is not necessary to
-call this function, as event objects are garbage- collected like all
-other objects; however, it may be more efficient to explicitly
-deallocate events when you are sure that this is safe.
-
-This emulation does not actually deallocate or reuse events
-except via garbage collection and `cons'."
- nil)
-
-(defun enqueue-eval-event: (function object)
- "Add an eval event to the back of the queue.
-It will be the next event read after all pending events."
- (setq unread-command-events
- (nconc unread-command-events
- (list (list 'eval function object)))))
-
-(defun eval-event-p (obj)
- "True if the argument is an eval or menu event object."
- (eq (car-safe obj) 'eval))
-
-(defun event-button (event)
- "Return the button-number of the given mouse-button-press event."
- (let ((sym (car (get (car event) 'event-symbol-elements))))
- (cdr (assq sym '((mouse-1 . 1) (mouse-2 . 2) (mouse-3 . 3)
- (mouse-4 . 4) (mouse-5 . 5))))))
-
-(defun event-function (event)
- "Return the callback function of the given timeout, menu, or eval event."
- (nth 1 event))
-
-(defun event-key (event)
- "Return the KeySym of the given key-press event.
-The value is an ASCII printing character (not upper case) or a symbol."
- (if (symbolp event)
- (car (get event 'event-symbol-elements))
- (let ((base (logand event (1- (ash 1 18)))))
- (downcase (if (< base 32) (logior base 64) base)))))
-
-(defun event-object (event)
- "Return the function argument of the given timeout, menu, or eval event."
- (nth 2 event))
-
-(defun event-point (event)
- "Return the character position of the given mouse-related event.
-If the event did not occur over a window, or did
-not occur over text, then this returns nil. Otherwise, it returns an index
-into the buffer visible in the event's window."
- (posn-point (event-end event)))
-
-;; Return position of start of line LINE in WINDOW.
-;; If LINE is nil, return the last position
-;; visible in WINDOW.
-(defun event-closest-point-1 (window &optional line)
- (let* ((total (- (window-height window)
- (if (window-minibuffer-p window)
- 0 1)))
- (distance (or line total)))
- (save-excursion
- (goto-char (window-start window))
- (if (= (vertical-motion distance) distance)
- (if (not line)
- (forward-char -1)))
- (point))))
-
-(defun event-closest-point (event &optional start-window)
- "Return the nearest position to where EVENT ended its motion.
-This is computed for the window where EVENT's motion started,
-or for window WINDOW if that is specified."
- (or start-window (setq start-window (posn-window (event-start event))))
- (if (eq start-window (posn-window (event-end event)))
- (if (eq (event-point event) 'vertical-line)
- (event-closest-point-1 start-window
- (cdr (posn-col-row (event-end event))))
- (if (eq (event-point event) 'mode-line)
- (event-closest-point-1 start-window)
- (event-point event)))
- ;; EVENT ended in some other window.
- (let* ((end-w (posn-window (event-end event)))
- (end-w-top)
- (w-top (nth 1 (window-edges start-window))))
- (setq end-w-top
- (if (windowp end-w)
- (nth 1 (window-edges end-w))
- (/ (cdr (posn-x-y (event-end event)))
- (frame-char-height end-w))))
- (if (>= end-w-top w-top)
- (event-closest-point-1 start-window)
- (window-start start-window)))))
-
-(defun event-process (event)
- "Return the process of the given process-output event."
- (nth 1 event))
-
-(defun event-timestamp (event)
- "Return the timestamp of the given event object.
-In Lucid Emacs, this works for any kind of event.
-In this emulation, it returns nil for non-mouse-related events."
- (and (listp event)
- (posn-timestamp (event-end event))))
-
-(defun event-to-character (event &optional lenient)
- "Return the closest ASCII approximation to the given event object.
-If the event isn't a keypress, this returns nil.
-If the second argument is non-nil, then this is lenient in its
-translation; it will ignore modifier keys other than control and meta,
-and will ignore the shift modifier on those characters which have no
-shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
-the same ASCII code as Control-A.) If the second arg is nil, then nil
-will be returned for events which have no direct ASCII equivalent."
- (if (symbolp event)
- (and lenient
- (cdr (assq event '((backspace . 8) (delete . 127) (tab . 9)
- (return . 10) (enter . 10)))))
- ;; Our interpretation is, ASCII means anything a number can represent.
- (if (integerp event)
- event nil)))
-
-(defun event-window (event)
- "Return the window of the given mouse-related event object."
- (posn-window (event-end event)))
-
-(defun event-x (event)
- "Return the X position in characters of the given mouse-related event."
- (/ (car (posn-col-row (event-end event)))
- (frame-char-width (window-frame (event-window event)))))
-
-(defun event-x-pixel (event)
- "Return the X position in pixels of the given mouse-related event."
- (car (posn-col-row (event-end event))))
-
-(defun event-y (event)
- "Return the Y position in characters of the given mouse-related event."
- (/ (cdr (posn-col-row (event-end event)))
- (frame-char-height (window-frame (event-window event)))))
-
-(defun event-y-pixel (event)
- "Return the Y position in pixels of the given mouse-related event."
- (cdr (posn-col-row (event-end event))))
-
-(defun key-press-event-p (obj)
- "True if the argument is a keyboard event object."
- (or (integerp obj)
- (and (symbolp obj)
- (get obj 'event-symbol-elements))))
-
-(defun menu-event-p (obj)
- "True if the argument is a menu event object."
- (eq (car-safe obj) 'menu))
-
-(defun motion-event-p (obj)
- "True if the argument is a mouse-motion event object."
- (eq (car-safe obj) 'mouse-movement))
-
-(defun read-command-event ()
- "Return the next keyboard or mouse event; execute other events.
-This is similar to the function `next-command-event' of Lucid Emacs,
-but different in that it returns the event rather than filling in
-an existing event object."
- (let (event)
- (while (progn
- (setq event (read-event))
- (not (or (key-press-event-p event)
- (button-press-event-p event)
- (button-release-event-p event)
- (menu-event-p event))))
- (let ((type (car-safe event)))
- (cond ((eq type 'eval)
- (funcall (nth 1 event) (nth 2 event)))
- ((eq type 'switch-frame)
- (select-frame (nth 1 event))))))
- event))
-
-(defun process-event-p (obj)
- "True if the argument is a process-output event object.
-GNU Emacs 19 does not currently generate process-output events."
- (eq (car-safe obj) 'process))
-
-(provide 'levents)
-
-;;; levents.el ends here
diff --git a/lisp/obsolete/lmenu.el b/lisp/obsolete/lmenu.el
deleted file mode 100644
index 678481924b2..00000000000
--- a/lisp/obsolete/lmenu.el
+++ /dev/null
@@ -1,445 +0,0 @@
-;;; lmenu.el --- emulate Lucid's menubar support
-
-;; Copyright (C) 1992-1994, 1997, 2001-2020 Free Software Foundation,
-;; Inc.
-
-;; Keywords: emulations obsolete
-;; Obsolete-since: 23.3
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file has been obsolete since Emacs 23.3.
-
-;;; Code:
-
-
-;; First, emulate the Lucid menubar support in GNU Emacs 19.
-
-;; Arrange to use current-menubar to set up part of the menu bar.
-
-(defvar current-menubar)
-(defvar lucid-menubar-map)
-(defvar lucid-failing-menubar)
-
-(defvar recompute-lucid-menubar 'recompute-lucid-menubar)
-(defun recompute-lucid-menubar ()
- (define-key lucid-menubar-map [menu-bar]
- (condition-case nil
- (make-lucid-menu-keymap "menu-bar" current-menubar)
- (error (message "Invalid data in current-menubar moved to lucid-failing-menubar")
- (sit-for 1)
- (setq lucid-failing-menubar current-menubar
- current-menubar nil))))
- (setq lucid-menu-bar-dirty-flag nil))
-
-(defvar lucid-menubar-map (make-sparse-keymap))
-(or (assq 'current-menubar minor-mode-map-alist)
- (setq minor-mode-map-alist
- (cons (cons 'current-menubar lucid-menubar-map)
- minor-mode-map-alist)))
-
-;; XEmacs compatibility
-(defun set-menubar-dirty-flag ()
- (force-mode-line-update)
- (setq lucid-menu-bar-dirty-flag t))
-
-(defvar add-menu-item-count 0)
-
-;; This is a variable whose value is always nil.
-(defvar make-lucid-menu-keymap-disable nil)
-
-;; Return a menu keymap corresponding to a Lucid-style menu list
-;; MENU-ITEMS, and with name MENU-NAME.
-(defun make-lucid-menu-keymap (menu-name menu-items)
- (let ((menu (make-sparse-keymap menu-name)))
- ;; Process items in reverse order,
- ;; since the define-key loop reverses them again.
- (setq menu-items (reverse menu-items))
- (while menu-items
- (let ((item (car menu-items))
- command name callback)
- (cond ((stringp item)
- (setq command nil)
- (setq name (if (string-match "^-+$" item) "" item)))
- ((consp item)
- (setq command (make-lucid-menu-keymap (car item) (cdr item)))
- (setq name (car item)))
- ((vectorp item)
- (setq command (make-symbol (format "menu-function-%d"
- add-menu-item-count))
- add-menu-item-count (1+ add-menu-item-count)
- name (aref item 0)
- callback (aref item 1))
- (if (symbolp callback)
- (fset command callback)
- (fset command (list 'lambda () '(interactive) callback)))
- (put command 'menu-alias t)
- (let ((i 2))
- (while (< i (length item))
- (cond
- ((eq (aref item i) ':active)
- (put command 'menu-enable
- (or (aref item (1+ i))
- 'make-lucid-menu-keymap-disable))
- (setq i (+ 2 i)))
- ((eq (aref item i) ':suffix)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':keys)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':style)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':selected)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((and (symbolp (aref item i))
- (= ?: (string-to-char (symbol-name (aref item i)))))
- (error "Unrecognized menu item keyword: %S"
- (aref item i)))
- ((= i 2)
- ;; old-style format: active-p &optional suffix
- (put command 'menu-enable
- (or (aref item i) 'make-lucid-menu-keymap-disable))
- ;; suffix is unimplemented
- (setq i (length item)))
- (t
- (error "Unexpected menu item value: %S"
- (aref item i))))))))
- (if (null command)
- ;; Handle inactive strings specially--allow any number
- ;; of identical ones.
- (setcdr menu (cons (list nil name) (cdr menu)))
- (if name
- (define-key menu (vector (intern name)) (cons name command)))))
- (setq menu-items (cdr menu-items)))
- menu))
-
-(declare-function x-popup-dialog "menu.c" (position contents &optional header))
-
-;; XEmacs compatibility function
-(defun popup-dialog-box (data)
- "Pop up a dialog box.
-A dialog box description is a list.
-
- - The first element of the list is a string to display in the dialog box.
- - The rest of the elements are descriptions of the dialog box's buttons.
- Each one is a vector of three elements:
- - The first element is the text of the button.
- - The second element is the `callback'.
- - The third element is t or nil, whether this button is selectable.
-
-If the `callback' of a button is a symbol, then it must name a command.
-It will be invoked with `call-interactively'. If it is a list, then it is
-evaluated with `eval'.
-
-One (and only one) of the buttons may be nil. This marker means that all
-following buttons should be flushright instead of flushleft.
-
-The syntax, more precisely:
-
- form := <something to pass to `eval'>
- command := <a symbol or string, to pass to `call-interactively'>
- callback := command | form
- active-p := <t, nil, or a form to evaluate to decide whether this
- button should be selectable>
- name := <string>
- partition := `nil'
- button := `[' name callback active-p `]'
- dialog := `(' name [ button ]+ [ partition [ button ]+ ] `)'"
- (let ((name (car data))
- (tail (cdr data))
- converted
- choice meaning)
- (while tail
- (if (null (car tail))
- (setq converted (cons nil converted))
- (let ((item (aref (car tail) 0))
- (callback (aref (car tail) 1))
- (enable (aref (car tail) 2)))
- (setq converted
- (cons (if enable (cons item callback) item)
- converted))))
- (setq tail (cdr tail)))
- (setq choice (x-popup-dialog t (cons name (nreverse converted))))
- (if choice
- (if (symbolp choice)
- (call-interactively choice)
- (eval choice)))))
-
-;; This is empty because the usual elements of the menu bar
-;; are provided by menu-bar.el instead.
-;; It would not make sense to duplicate them here.
-(defconst default-menubar nil)
-
-;; XEmacs compatibility
-(defun set-menubar (menubar)
- "Set the default menubar to be menubar."
- (setq-default current-menubar (copy-sequence menubar))
- (set-menubar-dirty-flag))
-
-;; XEmacs compatibility
-(defun set-buffer-menubar (menubar)
- "Set the buffer-local menubar to be menubar."
- (make-local-variable 'current-menubar)
- (setq current-menubar (copy-sequence menubar))
- (set-menubar-dirty-flag))
-
-
-;;; menu manipulation functions
-
-;; XEmacs compatibility
-(defun find-menu-item (menubar item-path-list &optional parent)
- "Searches MENUBAR for item given by ITEM-PATH-LIST.
-Returns (ITEM . PARENT), where PARENT is the immediate parent of
- the item found.
-Signals an error if the item is not found."
- (or parent (setq item-path-list (mapcar 'downcase item-path-list)))
- (if (not (consp menubar))
- nil
- (let ((rest menubar)
- result)
- (while rest
- (if (and (car rest)
- (equal (car item-path-list)
- (downcase (if (vectorp (car rest))
- (aref (car rest) 0)
- (if (stringp (car rest))
- (car rest)
- (car (car rest)))))))
- (setq result (car rest) rest nil)
- (setq rest (cdr rest))))
- (if (cdr item-path-list)
- (if (consp result)
- (find-menu-item (cdr result) (cdr item-path-list) result)
- (if result
- (signal 'error (list "not a submenu" result))
- (signal 'error (list "no such submenu" (car item-path-list)))))
- (cons result parent)))))
-
-
-;; XEmacs compatibility
-(defun disable-menu-item (path)
- "Make the named menu item be unselectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (consp item) (error "can't disable menus, only menu items"))
- (aset item 2 nil)
- (set-menubar-dirty-flag)
- item))
-
-
-;; XEmacs compatibility
-(defun enable-menu-item (path)
- "Make the named menu item be selectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (consp item) (error "%S is a menu, not a menu item" path))
- (aset item 2 t)
- (set-menubar-dirty-flag)
- item))
-
-
-(defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before)
- (if before (setq before (downcase before)))
- (let* ((menubar current-menubar)
- (menu (condition-case ()
- (car (find-menu-item menubar menu-path))
- (error nil)))
- (item (if (listp menu)
- (car (find-menu-item (cdr menu) (list item-name)))
- (signal 'error (list "not a submenu" menu-path)))))
- (or menu
- (let ((rest menu-path)
- (so-far menubar))
- (while rest
-;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
- (setq menu
- (if (eq so-far menubar)
- (car (find-menu-item so-far (list (car rest))))
- (car (find-menu-item (cdr so-far) (list (car rest))))))
- (or menu
- (let ((rest2 so-far))
- (or rest2
- (error "Trying to modify a menu that doesn't exist"))
- (while (and (cdr rest2) (car (cdr rest2)))
- (setq rest2 (cdr rest2)))
- (setcdr rest2
- (nconc (list (setq menu (list (car rest))))
- (cdr rest2)))))
- (setq so-far menu)
- (setq rest (cdr rest)))))
- (or menu (setq menu menubar))
- (if item
- nil ; it's already there
- (if item-p
- (setq item (vector item-name item-data enabled-p))
- (setq item (cons item-name item-data)))
- ;; if BEFORE is specified, try to add it there.
- (if before
- (setq before (car (find-menu-item menu (list before)))))
- (let ((rest menu)
- (added-before nil))
- (while rest
- (if (eq before (car (cdr rest)))
- (progn
- (setcdr rest (cons item (cdr rest)))
- (setq rest nil added-before t))
- (setq rest (cdr rest))))
- (if (not added-before)
- ;; adding before the first item on the menubar itself is harder
- (if (and (eq menu menubar) (eq before (car menu)))
- (setq menu (cons item menu)
- current-menubar menu)
- ;; otherwise, add the item to the end.
- (nconc menu (list item))))))
- (if item-p
- (progn
- (aset item 1 item-data)
- (aset item 2 (not (null enabled-p))))
- (setcar item item-name)
- (setcdr item item-data))
- (set-menubar-dirty-flag)
- item))
-
-;; XEmacs compatibility
-(defun add-menu-item (menu-path item-name function enabled-p &optional before)
- "Add a menu item to some menu, creating the menu first if necessary.
-If the named item exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu item should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
-ITEM-NAME is the string naming the menu item to be added.
-FUNCTION is the command to invoke when this menu item is selected.
- If it is a symbol, then it is invoked with `call-interactively', in the same
- way that functions bound to keys are invoked. If it is a list, then the
- list is simply evaluated.
-ENABLED-P controls whether the item is selectable or not.
-BEFORE, if provided, is the name of a menu item before which this item should
- be added, if this item is not on the menu already. If the item is already
- present, it will not be moved."
- (or menu-path (error "must specify a menu path"))
- (or item-name (error "must specify an item name"))
- (add-menu-item-1 t menu-path item-name function enabled-p before))
-
-
-;; XEmacs compatibility
-(defun delete-menu-item (path)
- "Remove the named menu item from the menu hierarchy.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (or (cdr pair) menubar)))
- (if (not item)
- nil
- ;; the menubar is the only special case, because other menus begin
- ;; with their name.
- (if (eq menu current-menubar)
- (setq current-menubar (delq item menu))
- (delq item menu))
- (set-menubar-dirty-flag)
- item)))
-
-
-;; XEmacs compatibility
-(defun relabel-menu-item (path new-name)
- "Change the string of the specified menu item.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
-NEW-NAME is the string that the menu item will be printed as from now on."
- (or (stringp new-name)
- (setq new-name (signal 'wrong-type-argument (list 'stringp new-name))))
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (and (consp item)
- (stringp (car item)))
- (setcar item new-name)
- (aset item 0 new-name))
- (set-menubar-dirty-flag)
- item))
-
-;; XEmacs compatibility
-(defun add-menu (menu-path menu-name menu-items &optional before)
- "Add a menu to the menubar or one of its submenus.
-If the named menu exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
- If MENU-PATH is nil, then the menu will be added to the menubar itself.
-MENU-NAME is the string naming the menu to be added.
-MENU-ITEMS is a list of menu item descriptions.
- Each menu item should be a vector of three elements:
- - a string, the name of the menu item;
- - a symbol naming a command, or a form to evaluate;
- - and a form whose value determines whether this item is selectable.
-BEFORE, if provided, is the name of a menu before which this menu should
- be added, if this menu is not on its parent already. If the menu is already
- present, it will not be moved."
- (or menu-name (error "must specify a menu name"))
- (or menu-items (error "must specify some menu items"))
- (add-menu-item-1 nil menu-path menu-name menu-items t before))
-
-
-
-(defvar put-buffer-names-in-file-menu t)
-
-
-;; Don't unconditionally enable menu bars; leave that up to the user.
-;;(let ((frames (frame-list)))
-;; (while frames
-;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
-;; (setq frames (cdr frames))))
-;;(or (assq 'menu-bar-lines default-frame-alist)
-;; (setq default-frame-alist
-;; (cons '(menu-bar-lines . 1) default-frame-alist)))
-
-(set-menubar default-menubar)
-
-(provide 'lmenu)
-
-;;; lmenu.el ends here
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index 2fba49f402d..cbe453aa6bf 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -37,6 +37,7 @@
;; Special thanks to Rod Smith for many useful bug reports.
;;; Code:
+;;; Options
(defgroup longlines nil
"Automatic wrapping of long lines when loading files."
@@ -76,7 +77,7 @@ This is used when `longlines-show-hard-newlines' is on."
:group 'longlines
:type 'string)
-;; Internal variables
+;;; Internal variables
(defvar longlines-wrap-beg nil)
(defvar longlines-wrap-end nil)
@@ -90,7 +91,7 @@ This is used when `longlines-show-hard-newlines' is on."
(make-variable-buffer-local 'longlines-showing)
(make-variable-buffer-local 'longlines-decoded)
-;; Mode
+;;; Mode
(defvar message-indent-citation-function)
@@ -210,7 +211,7 @@ This function exists to be called by `change-major-mode-hook' when the
major mode changes."
(longlines-mode 0))
-;; Showing the effect of hard newlines in the buffer
+;;; Showing the effect of hard newlines in the buffer
(defun longlines-show-hard-newlines (&optional arg)
"Make hard newlines visible by adding a face.
@@ -252,7 +253,7 @@ With optional argument ARG, make the hard newlines invisible again."
(setq pos (text-property-not-all (1+ pos) (point-max) 'hard nil)))
(restore-buffer-modified-p mod)))
-;; Wrapping the paragraphs.
+;;; Wrapping the paragraphs
(defun longlines-wrap-region (beg end)
"Wrap each successive line, starting with the line before BEG.
@@ -402,7 +403,7 @@ Hard newlines are left intact."
(setq pos (string-match "\n" str (1+ pos))))
str))
-;; Auto wrap
+;;; Auto wrap
(defun longlines-auto-wrap (&optional arg)
"Toggle automatic line wrapping.
@@ -457,7 +458,7 @@ This is called by `window-configuration-change-hook'."
(setq fill-column (- (window-width) dw))
(longlines-wrap-region (point-min) (point-max)))))
-;; Isearch
+;;; Isearch
(defun longlines-search-function ()
(cond
@@ -477,7 +478,7 @@ This is called by `window-configuration-change-hook'."
(let ((search-spaces-regexp " *[ \n]"))
(re-search-forward string bound noerror count)))
-;; Loading and saving
+;;; Loading and saving
(defun longlines-before-revert-hook ()
(add-hook 'after-revert-hook 'longlines-after-revert-hook nil t)
@@ -492,7 +493,7 @@ This is called by `window-configuration-change-hook'."
(list 'longlines "Automatically wrap long lines." nil nil
'longlines-encode-region t nil))
-;; Unloading
+;;; Unloading
(defun longlines-unload-function ()
"Unload the longlines library."
diff --git a/lisp/obsolete/lucid.el b/lisp/obsolete/lucid.el
deleted file mode 100644
index 817cc9cfaaa..00000000000
--- a/lisp/obsolete/lucid.el
+++ /dev/null
@@ -1,211 +0,0 @@
-;;; lucid.el --- emulate some Lucid Emacs functions
-
-;; Copyright (C) 1993, 1995, 2001-2020 Free Software Foundation, Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: emulations
-;; Obsolete-since: 23.2
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-;; XEmacs autoloads CL so we might as well make use of it.
-(require 'cl)
-
-(defalias 'current-time-seconds 'current-time)
-
-(defun real-path-name (name &optional default)
- (file-truename (expand-file-name name default)))
-
-;; It's not clear what to return if the mouse is not in FRAME.
-(defun read-mouse-position (frame)
- (let ((pos (mouse-position)))
- (if (eq (car pos) frame)
- (cdr pos))))
-
-(defun switch-to-other-buffer (arg)
- "Switch to the previous buffer.
-With a numeric arg N, switch to the Nth most recent buffer.
-With an arg of 0, buries the current buffer at the
-bottom of the buffer stack."
- (interactive "p")
- (if (eq arg 0)
- (bury-buffer (current-buffer)))
- (switch-to-buffer
- (if (<= arg 1) (other-buffer (current-buffer))
- (nth arg
- (apply 'nconc
- (mapcar
- (lambda (buf)
- (if (= ?\ (string-to-char (buffer-name buf)))
- nil
- (list buf)))
- (buffer-list)))))))
-
-(defun device-class (&optional device)
- "Return the class (color behavior) of DEVICE.
-This will be one of `color', `grayscale', or `mono'.
-This function exists for compatibility with XEmacs."
- (cond
- ((display-color-p device) 'color)
- ((display-grayscale-p device) 'grayscale)
- (t 'mono)))
-
-(defalias 'find-face 'facep)
-(defalias 'get-face 'facep)
-;; internal-try-face-font was removed from faces.el in rev 1.139, 1999/07/21.
-;;;(defalias 'try-face-font 'internal-try-face-font)
-
-(defalias 'exec-to-string 'shell-command-to-string)
-
-
-;; Buffer context
-
-(defun buffer-syntactic-context (&optional buffer)
- "Syntactic context at point in BUFFER.
-Either of `string', `comment' or nil.
-This is an XEmacs compatibility function."
- (with-current-buffer (or buffer (current-buffer))
- (let ((state (syntax-ppss (point))))
- (cond
- ((nth 3 state) 'string)
- ((nth 4 state) 'comment)))))
-
-
-(defun buffer-syntactic-context-depth (&optional buffer)
- "Syntactic parenthesis depth at point in BUFFER.
-This is an XEmacs compatibility function."
- (with-current-buffer (or buffer (current-buffer))
- (nth 0 (syntax-ppss (point)))))
-
-
-;; Extents
-(defun make-extent (beg end &optional buffer)
- (make-overlay beg end buffer))
-
-(defun extent-properties (extent) (overlay-properties extent))
-(unless (fboundp 'extent-property) (defalias 'extent-property 'overlay-get))
-
-(defun extent-at (pos &optional object property before)
- (with-current-buffer (or object (current-buffer))
- (let ((overlays (overlays-at pos 'sorted)))
- (when property
- (let (filtered)
- (while overlays
- (if (overlay-get (car overlays) property)
- (setq filtered (cons (car overlays) filtered)))
- (setq overlays (cdr overlays)))
- (setq overlays filtered)))
- (if before
- (nth 1 (memq before overlays))
- (car overlays)))))
-
-(defun set-extent-property (extent prop value)
- ;; Make sure that separate adjacent extents
- ;; with the same mouse-face value
- ;; do not run together as one extent.
- (and (eq prop 'mouse-face)
- (symbolp value)
- (setq value (list value)))
- (if (eq prop 'duplicable)
- (cond ((and value (not (overlay-get extent prop)))
- ;; If becoming duplicable, copy all overlayprops to text props.
- (add-text-properties (overlay-start extent)
- (overlay-end extent)
- (overlay-properties extent)
- (overlay-buffer extent)))
- ;; If becoming no longer duplicable, remove these text props.
- ((and (not value) (overlay-get extent prop))
- (remove-text-properties (overlay-start extent)
- (overlay-end extent)
- (overlay-properties extent)
- (overlay-buffer extent))))
- ;; If extent is already duplicable, put this property
- ;; on the text as well as on the overlay.
- (if (overlay-get extent 'duplicable)
- (put-text-property (overlay-start extent)
- (overlay-end extent)
- prop value (overlay-buffer extent))))
- (overlay-put extent prop value))
-
-(defun set-extent-face (extent face)
- (set-extent-property extent 'face face))
-
-(defun set-extent-end-glyph (extent glyph)
- (set-extent-property extent 'after-string glyph))
-
-(defun delete-extent (extent)
- (set-extent-property extent 'duplicable nil)
- (delete-overlay extent))
-
-;; Support the Lucid names with `screen' instead of `frame'.
-
-(defalias 'current-screen-configuration 'current-frame-configuration)
-(defalias 'delete-screen 'delete-frame)
-(defalias 'find-file-new-screen 'find-file-other-frame)
-(defalias 'find-file-read-only-new-screen 'find-file-read-only-other-frame)
-(defalias 'find-tag-new-screen 'find-tag-other-frame)
-;;(defalias 'focus-screen 'focus-frame)
-(defalias 'iconify-screen 'iconify-frame)
-(defalias 'mail-new-screen 'mail-other-frame)
-(defalias 'make-screen-invisible 'make-frame-invisible)
-(defalias 'make-screen-visible 'make-frame-visible)
-;; (defalias 'minibuffer-screen-list 'minibuffer-frame-list)
-(defalias 'modify-screen-parameters 'modify-frame-parameters)
-(defalias 'next-screen 'next-frame)
-;; (defalias 'next-multiscreen-window 'next-multiframe-window)
-;; (defalias 'previous-multiscreen-window 'previous-multiframe-window)
-;; (defalias 'redirect-screen-focus 'redirect-frame-focus)
-(defalias 'redraw-screen 'redraw-frame)
-;; (defalias 'screen-char-height 'frame-char-height)
-;; (defalias 'screen-char-width 'frame-char-width)
-;; (defalias 'screen-configuration-to-register 'frame-configuration-to-register)
-;; (defalias 'screen-focus 'frame-focus)
-(defalias 'screen-list 'frame-list)
-;; (defalias 'screen-live-p 'frame-live-p)
-(defalias 'screen-parameters 'frame-parameters)
-(defalias 'screen-pixel-height 'frame-pixel-height)
-(defalias 'screen-pixel-width 'frame-pixel-width)
-(defalias 'screen-root-window 'frame-root-window)
-(defalias 'screen-selected-window 'frame-selected-window)
-(defalias 'lower-screen 'lower-frame)
-(defalias 'raise-screen 'raise-frame)
-(defalias 'screen-visible-p 'frame-visible-p)
-(defalias 'screenp 'framep)
-(defalias 'select-screen 'select-frame)
-(defalias 'selected-screen 'selected-frame)
-;; (defalias 'set-screen-configuration 'set-frame-configuration)
-;; (defalias 'set-screen-height 'set-frame-height)
-(defalias 'set-screen-position 'set-frame-position)
-(defalias 'set-screen-size 'set-frame-size)
-;; (defalias 'set-screen-width 'set-frame-width)
-(defalias 'switch-to-buffer-new-screen 'switch-to-buffer-other-frame)
-;; (defalias 'unfocus-screen 'unfocus-frame)
-(defalias 'visible-screen-list 'visible-frame-list)
-(defalias 'window-screen 'window-frame)
-(defalias 'x-create-screen 'x-create-frame)
-(defalias 'x-new-screen 'make-frame)
-
-(provide 'lucid)
-
-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
-
-;;; lucid.el ends here
diff --git a/lisp/mail/metamail.el b/lisp/obsolete/metamail.el
index 0e407ea060e..d6ab4a3d0cf 100644
--- a/lisp/mail/metamail.el
+++ b/lisp/obsolete/metamail.el
@@ -4,6 +4,7 @@
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
;; Keywords: mail, news, mime, multimedia
+;; Obsolete-since: 28.1
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/nnir.el b/lisp/obsolete/nnir.el
index f1e31a0cd10..6f17854754d 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/obsolete/nnir.el
@@ -10,7 +10,9 @@
;; IMAP search improved by Daniel Pittman <daniel@rimspace.net>.
;; nnmaildir support for Swish++ and Namazu backends by:
;; Justus Piater <Justus <at> Piater.name>
+;; Mostly rewritten by Andrew Cohen <cohen@bu.edu> from 2010
;; Keywords: news mail searching ir
+;; Obsolete-since: 28.1
;; This file is part of GNU Emacs.
@@ -29,20 +31,11 @@
;;; Commentary:
-;; What does it do? Well, it allows you to search your mail using
-;; some search engine (imap, namazu, swish-e and others -- see
-;; later) by typing `G G' in the Group buffer. You will then get a
-;; buffer which shows all articles matching the query, sorted by
-;; Retrieval Status Value (score).
-
-;; When looking at the retrieval result (in the Summary buffer) you
-;; can type `A W' (aka M-x gnus-warp-to-article RET) on an article. You
-;; will be warped into the group this article came from. Typing `A T'
-;; (aka M-x gnus-summary-refer-thread RET) will warp to the group and
-;; also show the thread this article is part of.
+;; What does it do? Well, it searches your mail using some search
+;; engine (imap, namazu, swish-e, gmane and others -- see later).
;; The Lisp setup may involve setting a few variables and setting up the
-;; search engine. You can define the variables in the server definition
+;; search engine. You can define the variables in the server definition
;; like this :
;; (setq gnus-secondary-select-methods '(
;; (nnimap "" (nnimap-address "localhost")
@@ -53,6 +46,45 @@
;; an alist, type `C-h v nnir-engines RET' for more information; this
;; includes examples for setting `nnir-search-engine', too.)
+;; The entry to searching is the single function `nnir-run-query',
+;; which dispatches the search to the proper search function. The
+;; argument of `nnir-run-query' is an alist with two keys:
+;; 'nnir-query-spec and 'nnir-group-spec. The value for
+;; 'nnir-query-spec is an alist. The only required key/value pair is
+;; (query . "query") specifying the search string to pass to the query
+;; engine. Individual engines may have other elements. The value of
+;; 'nnir-group-spec is a list with the specification of the
+;; groups/servers to search. The format of the 'nnir-group-spec is
+;; (("server1" ("group11" "group12")) ("server2" ("group21"
+;; "group22"))). If any of the group lists is absent then all groups
+;; on that server are searched.
+
+;; The output of `nnir-run-query' is a vector, each element of which
+;; should in turn be a three-element vector with the form: [fully
+;; prefixed group-name of the article; the article number; the
+;; Retrieval Status Value (RSV)] as returned from the search engine.
+;; An RSV is the score assigned to the document by the search engine.
+;; For Boolean search engines, the RSV is always 1000 (or 1 or 100, or
+;; whatever you like).
+
+;; A vector of this form is used by the nnselect backend to create
+;; virtual groups. So nnir-run-query is a suitable function to use in
+;; nnselect groups.
+
+;; The default sorting order of articles in an nnselect summary buffer
+;; is based on the order of the articles in the above mentioned
+;; vector, so that's where you can do the sorting you'd like. Maybe
+;; it would be nice to have a way of displaying the search result
+;; sorted differently?
+
+;; So what do you need to do when you want to add another search
+;; engine? You write a function that executes the query. Temporary
+;; data from the search engine can be put in `nnir-tmp-buffer'. This
+;; function should return the list of articles as a vector, as
+;; described above. Then, you need to register this backend in
+;; `nnir-engines'. Then, users can choose the backend by setting
+;; `nnir-search-engine' as a server variable.
+
;; If you use one of the local indices (namazu, find-grep, swish) you
;; must also set up a search engine backend.
@@ -75,13 +107,13 @@
;; ,----
;; | package conf; # Don't remove this line!
;; |
-;; | # Paths which will not be indexed. Don't use `^' or `$' anchors.
+;; | # Paths which will not be indexed. Don't use `^' or `$' anchors.
;; | $EXCLUDE_PATH = "spam|sent";
;; |
-;; | # Header fields which should be searchable. case-insensitive
+;; | # Header fields which should be searchable. case-insensitive
;; | $REMAIN_HEADER = "from|date|message-id|subject";
;; |
-;; | # Searchable fields. case-insensitive
+;; | # Searchable fields. case-insensitive
;; | $SEARCH_FIELD = "from|date|message-id|subject";
;; |
;; | # The max length of a word.
@@ -121,72 +153,17 @@
;; | (nnml-active-file "~/News/cache/active"))
;; `----
-;; Developer information:
-
-;; I have tried to make the code expandable. Basically, it is divided
-;; into two layers. The upper layer is somewhat like the `nnvirtual'
-;; backend: given a specification of what articles to show from
-;; another backend, it creates a group containing exactly those
-;; articles. The lower layer issues a query to a search engine and
-;; produces such a specification of what articles to show from the
-;; other backend.
-
-;; The interface between the two layers consists of the single
-;; function `nnir-run-query', which dispatches the search to the
-;; proper search function. The argument of `nnir-run-query' is an
-;; alist with two keys: 'nnir-query-spec and 'nnir-group-spec. The
-;; value for 'nnir-query-spec is an alist. The only required key/value
-;; pair is (query . "query") specifying the search string to pass to
-;; the query engine. Individual engines may have other elements. The
-;; value of 'nnir-group-spec is a list with the specification of the
-;; groups/servers to search. The format of the 'nnir-group-spec is
-;; (("server1" ("group11" "group12")) ("server2" ("group21"
-;; "group22"))). If any of the group lists is absent then all groups
-;; on that server are searched.
-
-;; The output of `nnir-run-query' is supposed to be a vector, each
-;; element of which should in turn be a three-element vector. The
-;; first element should be full group name of the article, the second
-;; element should be the article number, and the third element should
-;; be the Retrieval Status Value (RSV) as returned from the search
-;; engine. An RSV is the score assigned to the document by the search
-;; engine. For Boolean search engines, the RSV is always 1000 (or 1
-;; or 100, or whatever you like).
-
-;; The sorting order of the articles in the summary buffer created by
-;; nnir is based on the order of the articles in the above mentioned
-;; vector, so that's where you can do the sorting you'd like. Maybe
-;; it would be nice to have a way of displaying the search result
-;; sorted differently?
-
-;; So what do you need to do when you want to add another search
-;; engine? You write a function that executes the query. Temporary
-;; data from the search engine can be put in `nnir-tmp-buffer'. This
-;; function should return the list of articles as a vector, as
-;; described above. Then, you need to register this backend in
-;; `nnir-engines'. Then, users can choose the backend by setting
-;; `nnir-search-engine' as a server variable.
;;; Code:
;;; Setup:
-(require 'nnoo)
-(require 'gnus-group)
-(require 'message)
-(require 'gnus-util)
(eval-when-compile (require 'cl-lib))
+(require 'gnus)
;;; Internal Variables:
-(defvar nnir-memo-query nil
- "Internal: stores current query.")
-
-(defvar nnir-memo-server nil
- "Internal: stores current server.")
-
-(defvar nnir-artlist nil
- "Internal: stores search result.")
+(defvar gnus-inhibit-demon)
(defvar nnir-search-history ()
"Internal: the history for querying search options in nnir.")
@@ -203,30 +180,19 @@
("to" . "TO")
("from" . "FROM")
("body" . "BODY")
- ("imap" . ""))
+ ("imap" . "")
+ ("gmail" . "X-GM-RAW"))
"Mapping from user readable keys to IMAP search items for use in nnir.")
(defvar nnir-imap-search-other "HEADER %S"
- "The IMAP search item to use for anything other than
-`nnir-imap-search-arguments'. By default this is the name of an
-email header field.")
+ "The IMAP search item for anything other than `nnir-imap-search-arguments'.
+By default this is the name of an email header field.")
(defvar nnir-imap-search-argument-history ()
"The history for querying search options in nnir.")
;;; Helper macros
-;; Data type article list.
-
-(defmacro nnir-artlist-length (artlist)
- "Return number of articles in artlist."
- `(length ,artlist))
-
-(defmacro nnir-artlist-article (artlist n)
- "Return from ARTLIST the Nth artitem (counting starting at 1)."
- `(when (> ,n 0)
- (elt ,artlist (1- ,n))))
-
(defmacro nnir-artitem-group (artitem)
"Return the group from the ARTITEM."
`(elt ,artitem 0))
@@ -239,52 +205,6 @@ email header field.")
"Return the Retrieval Status Value (RSV, score) from the ARTITEM."
`(elt ,artitem 2))
-(defmacro nnir-article-group (article)
- "Return the group for ARTICLE."
- `(nnir-artitem-group (nnir-artlist-article nnir-artlist ,article)))
-
-(defmacro nnir-article-number (article)
- "Return the number for ARTICLE."
- `(nnir-artitem-number (nnir-artlist-article nnir-artlist ,article)))
-
-(defmacro nnir-article-rsv (article)
- "Return the rsv for ARTICLE."
- `(nnir-artitem-rsv (nnir-artlist-article nnir-artlist ,article)))
-
-(defsubst nnir-article-ids (article)
- "Return the pair `(nnir id . real id)' of ARTICLE."
- (cons article (nnir-article-number article)))
-
-(defmacro nnir-categorize (sequence keyfunc &optional valuefunc)
- "Sort a SEQUENCE into categories and returns a list of the form
-`((key1 (element11 element12)) (key2 (element21 element22))'.
-The category key for a member of the sequence is obtained
-as `(KEYFUNC member)' and the corresponding element is just
-`member'. If VALUEFUNC is non-nil, the element of the list
-is `(VALUEFUNC member)'."
- `(unless (null ,sequence)
- (let (value)
- (mapc
- (lambda (member)
- (let ((y (,keyfunc member))
- (x ,(if valuefunc
- `(,valuefunc member)
- 'member)))
- (if (assoc y value)
- (push x (cadr (assoc y value)))
- (push (list y (list x)) value))))
- ,sequence)
- value)))
-
-;;; Finish setup:
-
-(require 'gnus-sum)
-
-(nnoo-declare nnir)
-(nnoo-define-basics nnir)
-
-(gnus-declare-backend "nnir" 'mail 'virtual)
-
;;; User Customizable Variables:
@@ -292,12 +212,9 @@ is `(VALUEFUNC member)'."
"Search groups in Gnus with assorted search engines."
:group 'gnus)
-(defcustom nnir-ignored-newsgroups ""
- "A regexp to match newsgroups in the active file that should
-be skipped when searching."
- :version "24.1"
- :type '(regexp)
- :group 'nnir)
+(make-obsolete-variable 'nnir-summary-line-format "The formatting
+specs previously unique to this variable may now be set in
+'gnus-summary-line-format." "28.1")
(defcustom nnir-summary-line-format nil
"The format specification of the lines in an nnir summary buffer.
@@ -314,22 +231,19 @@ If nil this will use `gnus-summary-line-format'."
:type '(choice (const :tag "gnus-summary-line-format" nil) string)
:group 'nnir)
-(defcustom nnir-retrieve-headers-override-function nil
- "If non-nil, a function that accepts an article list and group
-and populates the `nntp-server-buffer' with the retrieved
-headers. Must return either `nov' or `headers' indicating the
-retrieved header format.
-If this variable is nil, or if the provided function returns nil for
-a search result, `gnus-retrieve-headers' will be called instead."
+(defcustom nnir-ignored-newsgroups ""
+ "Newsgroups to skip when searching.
+Any newsgroup in the active file matching this regexp will be
+skipped when searching."
:version "24.1"
- :type '(choice (const :tag "gnus-retrieve-headers" nil) function)
+ :type '(regexp)
:group 'nnir)
(defcustom nnir-imap-default-search-key "whole message"
- "The default IMAP search key for an nnir search. Must be one of
-the keys in `nnir-imap-search-arguments'. To use raw imap queries
-by default set this to \"imap\"."
+ "The default IMAP search key for an nnir search.
+Must be one of the keys in `nnir-imap-search-arguments'. To use
+raw imap queries by default set this to \"imap\"."
:version "24.1"
:type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
nnir-imap-search-arguments))
@@ -357,9 +271,9 @@ Instead, use this:
:group 'nnir)
(defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
- "The prefix to remove from each file name returned by swish++
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
+ "The prefix to remove from swish++ file names to get group names.
+Resulting names have '/' in place of '.'. This is a regular
+expression.
This variable is very similar to `nnir-namazu-remove-prefix', except
that it is for swish++, not Namazu."
@@ -408,9 +322,9 @@ This could be a server parameter."
:group 'nnir)
(defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
- "The prefix to remove from each file name returned by swish-e
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
+ "The prefix to remove from swish-e file names to get group names.
+Resulting names have '/' in place of '.'. This is a regular
+expression.
This variable is very similar to `nnir-namazu-remove-prefix', except
that it is for swish-e, not Namazu.
@@ -441,8 +355,8 @@ Instead, use this:
:group 'nnir)
(defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/")
- "The prefix to remove from each file name returned by HyREX
-in order to get a group name (albeit with / instead of .).
+ "The prefix to remove from HyREX file names to get group names.
+Resulting names have '/' in place of '.'.
For example, suppose that HyREX returns file names such as
\"/home/john/Mail/mail/misc/42\". For this example, use the following
@@ -478,8 +392,8 @@ Instead, use this:
:group 'nnir)
(defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
- "The prefix to remove from each file name returned by Namazu
-in order to get a group name (albeit with / instead of .).
+ "The prefix to remove from Namazu file names to get group names.
+Resulting names have '/' in place of '.'.
For example, suppose that Namazu returns file names such as
\"/home/john/Mail/mail/misc/42\". For this example, use the following
@@ -509,9 +423,9 @@ Instead, use this:
(defcustom nnir-notmuch-remove-prefix
(regexp-quote (or (getenv "MAILDIR") (expand-file-name "~/Mail")))
- "The prefix to remove from each file name returned by notmuch
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
+ "The prefix to remove from notmuch file names to get group names.
+Resulting names have '/' in place of '.'. This is a regular
+expression.
This variable is very similar to `nnir-namazu-remove-prefix', except
that it is for notmuch, not Namazu."
@@ -590,346 +504,12 @@ Add an entry here when adding a new search engine.")
,@(mapcar (lambda (elem) (list 'const (car elem)))
nnir-engines)))))
-;; Gnus glue.
-
-(declare-function gnus-group-topic-name "gnus-topic" ())
-(declare-function gnus-topic-find-groups "gnus-topic"
- (topic &optional level all lowest recursive))
-
-(defun gnus-group-make-nnir-group (nnir-extra-parms &optional specs)
- "Create an nnir group.
-Prompt for a search query and determine the groups to search as
-follows: if called from the *Server* buffer search all groups
-belonging to the server on the current line; if called from the
-*Group* buffer search any marked groups, or the group on the current
-line, or all the groups under the current topic. Calling with a
-prefix-arg prompts for additional search-engine specific constraints.
-A non-nil `specs' arg must be an alist with `nnir-query-spec' and
-`nnir-group-spec' keys, and skips all prompting."
- (interactive "P")
- (let* ((group-spec
- (or (cdr (assq 'nnir-group-spec specs))
- (if (gnus-server-server-name)
- (list (list (gnus-server-server-name)))
- (nnir-categorize
- (or gnus-group-marked
- (if (gnus-group-group-name)
- (list (gnus-group-group-name))
- (mapcar (lambda (entry)
- (gnus-info-group (cadr entry)))
- (gnus-topic-find-groups (gnus-group-topic-name)))))
- gnus-group-server))))
- (query-spec
- (or (cdr (assq 'nnir-query-spec specs))
- (apply
- 'append
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
- (when nnir-extra-parms
- (mapcar
- (lambda (x)
- (nnir-read-parms (nnir-server-to-search-engine (car x))))
- group-spec))))))
- (gnus-group-read-ephemeral-group
- (concat "nnir-" (message-unique-id))
- (list 'nnir "nnir")
- nil
-; (cons (current-buffer) gnus-current-window-configuration)
- nil
- nil nil
- (list
- (cons 'nnir-specs (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))
- (cons 'nnir-artlist nil)))))
-
-(defun gnus-summary-make-nnir-group (nnir-extra-parms)
- "Search a group from the summary buffer."
- (interactive "P")
- (gnus-warp-to-article)
- (let ((spec
- (list
- (cons 'nnir-group-spec
- (list (list
- (gnus-group-server gnus-newsgroup-name)
- (list gnus-newsgroup-name)))))))
- (gnus-group-make-nnir-group nnir-extra-parms spec)))
-
-
-;; Gnus backend interface functions.
-
-(deffoo nnir-open-server (server &optional definitions)
- ;; Just set the server variables appropriately.
- (let ((backend (car (gnus-server-to-method server))))
- (if backend
- (nnoo-change-server backend server definitions)
- (add-hook 'gnus-summary-generate-hook 'nnir-mode)
- (nnoo-change-server 'nnir server definitions))))
-
-(deffoo nnir-request-group (group &optional server dont-check _info)
- (nnir-possibly-change-group group server)
- (let ((pgroup (gnus-group-guess-full-name-from-command-method group))
- length)
- ;; Check for cached search result or run the query and cache the
- ;; result.
- (unless (and nnir-artlist dont-check)
- (gnus-group-set-parameter
- pgroup 'nnir-artlist
- (setq nnir-artlist
- (nnir-run-query
- (gnus-group-get-parameter pgroup 'nnir-specs t))))
- (nnir-request-update-info pgroup (gnus-get-info pgroup)))
- (with-current-buffer nntp-server-buffer
- (if (zerop (setq length (nnir-artlist-length nnir-artlist)))
- (progn
- (nnir-close-group group)
- (nnheader-report 'nnir "Search produced empty results."))
- (nnheader-insert "211 %d %d %d %s\n"
- length ; total #
- 1 ; first #
- length ; last #
- group)))) ; group name
- nnir-artlist)
-
-(defvar gnus-inhibit-demon)
-
-(deffoo nnir-retrieve-headers (articles &optional _group _server _fetch-old)
- (with-current-buffer nntp-server-buffer
- (let ((gnus-inhibit-demon t)
- (articles-by-group (nnir-categorize
- articles nnir-article-group nnir-article-ids))
- headers)
- (while (not (null articles-by-group))
- (let* ((group-articles (pop articles-by-group))
- (artgroup (car group-articles))
- (articleids (cadr group-articles))
- (artlist (sort (mapcar 'cdr articleids) '<))
- (server (gnus-group-server artgroup))
- (gnus-override-method (gnus-server-to-method server))
- parsefunc)
- ;; (nnir-possibly-change-group nil server)
- (erase-buffer)
- (pcase (setq gnus-headers-retrieved-by
- (or
- (and
- nnir-retrieve-headers-override-function
- (funcall nnir-retrieve-headers-override-function
- artlist artgroup))
- (gnus-retrieve-headers artlist artgroup nil)))
- ('nov
- (setq parsefunc 'nnheader-parse-nov))
- ('headers
- (setq parsefunc 'nnheader-parse-head))
- (_ (error "Unknown header type %s while requesting articles \
- of group %s" gnus-headers-retrieved-by artgroup)))
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((novitem (funcall parsefunc))
- (artno (and novitem
- (mail-header-number novitem)))
- (art (car (rassq artno articleids))))
- (when art
- (setf (mail-header-number novitem) art)
- (push novitem headers))
- (forward-line 1)))))
- (setq headers
- (sort headers
- (lambda (x y)
- (< (mail-header-number x) (mail-header-number y)))))
- (erase-buffer)
- (mapc 'nnheader-insert-nov headers)
- 'nov)))
-
-(defvar gnus-article-decode-hook)
-
-(deffoo nnir-request-article (article &optional group server to-buffer)
- (nnir-possibly-change-group group server)
- (if (and (stringp article)
- (not (eq 'nnimap (car (gnus-server-to-method server)))))
- (nnheader-report
- 'nnir
- "nnir-request-article only groks message ids for nnimap servers: %s"
- server)
- (save-excursion
- (let ((article article)
- query)
- (when (stringp article)
- (setq gnus-override-method (gnus-server-to-method server))
- (setq query
- (list
- (cons 'query (format "HEADER Message-ID %s" article))
- (cons 'criteria "")
- (cons 'shortcut t)))
- (unless (and nnir-artlist (equal query nnir-memo-query)
- (equal server nnir-memo-server))
- (setq nnir-artlist (nnir-run-imap query server)
- nnir-memo-query query
- nnir-memo-server server))
- (setq article 1))
- (unless (zerop (nnir-artlist-length nnir-artlist))
- (let ((artfullgroup (nnir-article-group article))
- (artno (nnir-article-number article)))
- (message "Requesting article %d from group %s"
- artno artfullgroup)
- (if to-buffer
- (with-current-buffer to-buffer
- (let ((gnus-article-decode-hook nil))
- (gnus-request-article-this-buffer artno artfullgroup)))
- (gnus-request-article artno artfullgroup))
- (cons artfullgroup artno)))))))
-
-(deffoo nnir-request-move-article (article group server accept-form
- &optional last _internal-move-group)
- (nnir-possibly-change-group group server)
- (let* ((artfullgroup (nnir-article-group article))
- (artno (nnir-article-number article))
- (to-newsgroup (nth 1 accept-form))
- (to-method (gnus-find-method-for-group to-newsgroup))
- (from-method (gnus-find-method-for-group artfullgroup))
- (move-is-internal (gnus-server-equal from-method to-method)))
- (unless (gnus-check-backend-function
- 'request-move-article artfullgroup)
- (error "The group %s does not support article moving" artfullgroup))
- (gnus-request-move-article
- artno
- artfullgroup
- (nth 1 from-method)
- accept-form
- last
- (and move-is-internal
- to-newsgroup ; Not respooling
- (gnus-group-real-name to-newsgroup)))))
-
-(deffoo nnir-request-expire-articles (articles group &optional server force)
- (nnir-possibly-change-group group server)
- (if force
- (let ((articles-by-group (nnir-categorize
- articles nnir-article-group nnir-article-ids))
- not-deleted)
- (while (not (null articles-by-group))
- (let* ((group-articles (pop articles-by-group))
- (artgroup (car group-articles))
- (articleids (cadr group-articles))
- (artlist (sort (mapcar 'cdr articleids) '<)))
- (unless (gnus-check-backend-function 'request-expire-articles
- artgroup)
- (error "The group %s does not support article deletion" artgroup))
- (unless (gnus-check-server (gnus-find-method-for-group artgroup))
- (error "Couldn't open server for group %s" artgroup))
- (push (gnus-request-expire-articles
- artlist artgroup force)
- not-deleted)))
- (sort (delq nil not-deleted) '<))
- articles))
-
-(deffoo nnir-warp-to-article ()
- (nnir-possibly-change-group gnus-newsgroup-name)
- (let* ((cur (if (> (gnus-summary-article-number) 0)
- (gnus-summary-article-number)
- (error "Can't warp to a pseudo-article")))
- (backend-article-group (nnir-article-group cur))
- (backend-article-number (nnir-article-number cur))
-; (quit-config (gnus-ephemeral-group-p gnus-newsgroup-name))
- )
-
- ;; what should we do here? we could leave all the buffers around
- ;; and assume that we have to exit from them one by one. or we can
- ;; try to clean up directly
-
- ;;first exit from the nnir summary buffer.
-; (gnus-summary-exit)
- ;; and if the nnir summary buffer in turn came from another
- ;; summary buffer we have to clean that summary up too.
- ; (when (not (eq (cdr quit-config) 'group))
-; (gnus-summary-exit))
- (gnus-summary-read-group-1 backend-article-group t t nil
- nil (list backend-article-number))))
-
-(deffoo nnir-request-update-mark (_group article mark)
- (let ((artgroup (nnir-article-group article))
- (artnumber (nnir-article-number article)))
- (or (and artgroup
- artnumber
- (gnus-request-update-mark artgroup artnumber mark))
- mark)))
-
-(deffoo nnir-request-set-mark (group actions &optional server)
- (nnir-possibly-change-group group server)
- (let (mlist)
- (dolist (action actions)
- (cl-destructuring-bind (range action marks) action
- (let ((articles-by-group (nnir-categorize
- (gnus-uncompress-range range)
- nnir-article-group nnir-article-number)))
- (dolist (artgroup articles-by-group)
- (push (list
- (car artgroup)
- (list (gnus-compress-sequence
- (sort (cadr artgroup) '<))
- action marks))
- mlist)))))
- (dolist (request (nnir-categorize mlist car cadr))
- (gnus-request-set-mark (car request) (cadr request)))))
-
-
-(deffoo nnir-request-update-info (group info &optional server)
- (nnir-possibly-change-group group server)
- ;; clear out all existing marks.
- (setf (gnus-info-marks info) nil)
- (setf (gnus-info-read info) nil)
- (let ((group (gnus-group-guess-full-name-from-command-method group))
- (articles-by-group
- (nnir-categorize
- (gnus-uncompress-range (cons 1 (nnir-artlist-length nnir-artlist)))
- nnir-article-group nnir-article-ids)))
- (gnus-set-active group
- (cons 1 (nnir-artlist-length nnir-artlist)))
- (while (not (null articles-by-group))
- (let* ((group-articles (pop articles-by-group))
- (articleids (reverse (cadr group-articles)))
- (group-info (gnus-get-info (car group-articles)))
- (marks (gnus-info-marks group-info))
- (read (gnus-info-read group-info)))
- (setf (gnus-info-read info)
- (gnus-add-to-range
- (gnus-info-read info)
- (delq nil
- (mapcar
- #'(lambda (art)
- (when (gnus-member-of-range (cdr art) read)
- (car art)))
- articleids))))
- (dolist (mark marks)
- (cl-destructuring-bind (type . range) mark
- (gnus-add-marked-articles
- group type
- (delq nil
- (mapcar
- #'(lambda (art)
- (when (gnus-member-of-range (cdr art) range) (car art)))
- articleids)))))))))
-
-
-(deffoo nnir-close-group (group &optional server)
- (nnir-possibly-change-group group server)
- (let ((pgroup (gnus-group-guess-full-name-from-command-method group)))
- (when (and nnir-artlist (not (gnus-ephemeral-group-p pgroup)))
- (gnus-group-set-parameter pgroup 'nnir-artlist nnir-artlist))
- (setq nnir-artlist nil)
- (when (gnus-ephemeral-group-p pgroup)
- (gnus-kill-ephemeral-group pgroup)
- (setq gnus-ephemeral-servers
- (delq (assq 'nnir gnus-ephemeral-servers)
- gnus-ephemeral-servers)))))
-;; (gnus-opened-servers-remove
-;; (car (assoc '(nnir "nnir-ephemeral" (nnir-address "nnir"))
-;; gnus-opened-servers))))
-
-
-
(defmacro nnir-add-result (dirnam artno score prefix server artlist)
- "Ask `nnir-compose-result' to construct a result vector,
-and if it is non-nil, add it to ARTLIST."
+ "Construct a result vector and add it to ARTLIST.
+DIRNAM, ARTNO, SCORE, PREFIX and SERVER are passed to
+`nnir-compose-result' to make the vector. Only add the result if
+non-nil."
`(let ((result (nnir-compose-result ,dirnam ,artno ,score ,prefix ,server)))
(when (not (null result))
(push result ,artlist))))
@@ -939,9 +519,9 @@ and if it is non-nil, add it to ARTLIST."
;; Helper function currently used by the Swish++ and Namazu backends;
;; perhaps useful for other backends as well
(defun nnir-compose-result (dirnam article score prefix server)
- "Extract the group from DIRNAM, and create a result vector
-ready to be added to the list of search results."
-
+ "Construct a result vector.
+The DIRNAM, ARTICLE, SCORE, PREFIX, and SERVER are used to
+construct the vector entries."
;; remove nnir-*-remove-prefix from beginning of dirnam filename
(when (string-match (concat "^" prefix) dirnam)
(setq dirnam (replace-match "" t t dirnam)))
@@ -970,62 +550,64 @@ ready to be added to the list of search results."
;;; Search Engine Interfaces:
+(autoload 'gnus-server-get-active "gnus-int")
(autoload 'nnimap-change-group "nnimap")
(declare-function nnimap-buffer "nnimap" ())
(declare-function nnimap-command "nnimap" (&rest args))
;; imap interface
(defun nnir-run-imap (query srv &optional groups)
- "Run a search against an IMAP back-end server.
-This uses a custom query language parser; see `nnir-imap-make-query'
-for details on the language and supported extensions."
+ "Run the QUERY search against an IMAP back-end server SRV.
+Search GROUPS, or all active groups on SRV if GROUPS is nil.
+This uses a custom query language parser; see
+`nnir-imap-make-query' for details on the language and supported
+extensions."
(save-excursion
(let ((qstring (cdr (assq 'query query)))
(server (cadr (gnus-server-to-method srv)))
-;; (defs (nth 2 (gnus-server-to-method srv)))
(criteria (or (cdr (assq 'criteria query))
(cdr (assoc nnir-imap-default-search-key
nnir-imap-search-arguments))))
(gnus-inhibit-demon t)
- (groups (or groups (nnir-get-active srv))))
+ (groups
+ (or groups (gnus-server-get-active srv nnir-ignored-newsgroups))))
(message "Opening server %s" server)
(apply
'vconcat
(catch 'found
(mapcar
#'(lambda (group)
- (let (artlist)
- (condition-case ()
- (when (nnimap-change-group
- (gnus-group-short-name group) server)
- (with-current-buffer (nnimap-buffer)
- (message "Searching %s..." group)
- (let ((arts 0)
- (result (nnimap-command "UID SEARCH %s"
- (if (string= criteria "")
- qstring
- (nnir-imap-make-query
- criteria qstring)))))
- (mapc
- (lambda (artnum)
- (let ((artn (string-to-number artnum)))
- (when (> artn 0)
- (push (vector group artn 100)
- artlist)
- (when (assq 'shortcut query)
- (throw 'found (list artlist)))
- (setq arts (1+ arts)))))
- (and (car result)
- (cdr (assoc "SEARCH" (cdr result)))))
- (message "Searching %s... %d matches" group arts)))
- (message "Searching %s...done" group))
- (quit nil))
- (nreverse artlist)))
+ (let (artlist)
+ (condition-case ()
+ (when (nnimap-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let ((arts 0)
+ (result (nnimap-command "UID SEARCH %s"
+ (if (string= criteria "")
+ qstring
+ (nnir-imap-make-query
+ criteria qstring)))))
+ (mapc
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (push (vector group artn 100)
+ artlist)
+ (when (assq 'shortcut query)
+ (throw 'found (list artlist)))
+ (setq arts (1+ arts)))))
+ (and (car result)
+ (cdr (assoc "SEARCH" (cdr result)))))
+ (message "Searching %s... %d matches" group arts)))
+ (message "Searching %s...done" group))
+ (quit nil))
+ (nreverse artlist)))
groups))))))
(defun nnir-imap-make-query (criteria qstring)
- "Parse the query string and criteria into an appropriate IMAP search
-expression, returning the string query to make.
+ "Make an IMAP search expression from QSTRING and CRITERIA.
This implements a little language designed to return the expected
results to an arbitrary query string to the end user.
@@ -1062,7 +644,7 @@ In the future the following will be added to the language:
(defun nnir-imap-query-to-imap (criteria query)
- "Turn an s-expression format QUERY into IMAP."
+ "Turn an s-expression format QUERY with CRITERIA into IMAP."
(mapconcat
;; Turn the expressions into IMAP text
(lambda (item)
@@ -1098,8 +680,9 @@ In the future the following will be added to the language:
(defun nnir-imap-parse-query (string)
- "Turn STRING into an s-expression based query based on the IMAP
-query language as defined in `nnir-imap-make-query'.
+ "Turn STRING into an s-expression query.
+STRING is based on the IMAP query language as defined in
+`nnir-imap-make-query'.
This involves turning individual tokens into higher level terms
that the search language can then understand and use."
@@ -1115,7 +698,7 @@ that the search language can then understand and use."
(defun nnir-imap-next-expr (&optional count)
- "Return the next expression from the current buffer."
+ "Return the next (COUNT) expression from the current buffer."
(let ((term (nnir-imap-next-term count))
(next (nnir-imap-peek-symbol)))
;; Are we looking at an 'or' expression?
@@ -1128,7 +711,7 @@ that the search language can then understand and use."
(defun nnir-imap-next-term (&optional count)
- "Return the next term from the current buffer."
+ "Return the next (COUNT) term from the current buffer."
(let ((term (nnir-imap-next-symbol count)))
;; What sort of term is this?
(cond
@@ -1146,9 +729,10 @@ that the search language can then understand and use."
(nnir-imap-next-symbol)))
(defun nnir-imap-next-symbol (&optional count)
- "Return the next symbol from the current buffer, or nil if we are
-at the end of the buffer. If supplied COUNT skips some symbols before
-returning the one at the supplied position."
+ "Return the next (COUNT) symbol from the current buffer.
+Return nil if we are at the end of the buffer. If supplied COUNT
+skips some symbols before returning the one at the supplied
+position."
(when (and (numberp count) (> count 1))
(nnir-imap-next-symbol (1- count)))
(let ((case-fold-search t))
@@ -1179,7 +763,7 @@ returning the one at the supplied position."
(buffer-substring start end)))))))
(defun nnir-imap-delimited-string (delimiter)
- "Return a delimited string from the current buffer."
+ "Return a string delimited by DELIMITER from the current buffer."
(let ((start (point)) end)
(forward-char 1) ; skip the first delimiter.
(while (not end)
@@ -1206,7 +790,7 @@ returning the one at the supplied position."
;; - file size
;; - group
(defun nnir-run-swish++ (query server &optional _group)
- "Run QUERY against swish++.
+ "Run QUERY on SERVER against swish++.
Returns a vector of (group name, file name) pairs (also vectors,
actually).
@@ -1234,7 +818,7 @@ Windows NT 4.0."
(when (equal "" qstring)
(error "swish++: You didn't enter anything"))
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(erase-buffer)
(if groupspec
@@ -1290,13 +874,13 @@ Windows NT 4.0."
;; Sort by score
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y))))))))
;; Swish-E interface.
(defun nnir-run-swish-e (query server &optional _group)
- "Run given QUERY against swish-e.
+ "Run given QUERY on SERVER against swish-e.
Returns a vector of (group name, file name) pairs (also vectors,
actually).
@@ -1316,7 +900,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
(when (equal "" qstring)
(error "swish-e: You didn't enter anything"))
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(erase-buffer)
(message "Doing swish-e query %s..." query)
@@ -1385,12 +969,13 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
;; Sort by score
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y))))))))
;; HyREX interface
(defun nnir-run-hyrex (query server &optional group)
+ "Run given QUERY with GROUP on SERVER against hyrex."
(save-excursion
(let ((artlist nil)
(groupspec (cdr (assq 'hyrex-group query)))
@@ -1401,7 +986,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
(setq groupspec
(regexp-opt
(mapcar (lambda (x) (gnus-group-real-name x)) group))))
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(erase-buffer)
(message "Doing hyrex-search query %s..." query)
(let* ((cp-list
@@ -1452,17 +1037,17 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
(message "Massaging hyrex-search output...done.")
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (if (string-lessp (nnir-artitem-group x)
- (nnir-artitem-group y))
- t
- (< (nnir-artitem-number x)
- (nnir-artitem-number y)))))))
+ (lambda (x y)
+ (if (string-lessp (nnir-artitem-group x)
+ (nnir-artitem-group y))
+ t
+ (< (nnir-artitem-number x)
+ (nnir-artitem-number y))))))
)))
;; Namazu interface
(defun nnir-run-namazu (query server &optional _group)
- "Run given QUERY against Namazu.
+ "Run QUERY on SERVER against Namazu.
Returns a vector of (group name, file name) pairs (also vectors,
actually).
@@ -1480,7 +1065,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
score group article
(process-environment (copy-sequence process-environment)))
(setenv "LC_MESSAGES" "C")
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(erase-buffer)
(let* ((cp-list
`( ,nnir-namazu-program
@@ -1527,12 +1112,12 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
;; sort artlist by score
(apply #'vector
(sort artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
+ (lambda (x y)
+ (> (nnir-artitem-rsv x)
+ (nnir-artitem-rsv y))))))))
(defun nnir-run-notmuch (query server &optional groups)
- "Run QUERY against notmuch.
+ "Run QUERY with GROUPS from SERVER against notmuch.
Returns a vector of (group name, file name) pairs (also vectors,
actually). If GROUPS is a list of group names, use them to
construct path: search terms (see the variable
@@ -1561,7 +1146,7 @@ construct path: search terms (see the variable
(when (equal "" qstring)
(error "notmuch: You didn't enter anything"))
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(erase-buffer)
(if groups
@@ -1616,14 +1201,15 @@ construct path: search terms (see the variable
artlist)))
(defun nnir-run-find-grep (query server &optional grouplist)
- "Run find and grep to obtain matching articles."
+ "Run find and grep to QUERY GROUPLIST on SERVER for matching articles."
(let* ((method (gnus-server-to-method server))
(sym (intern
(concat (symbol-name (car method)) "-directory")))
(directory (cadr (assoc sym (cddr method))))
(regexp (cdr (assoc 'query query)))
(grep-options (cdr (assoc 'grep-options query)))
- (grouplist (or grouplist (nnir-get-active server))))
+ (grouplist
+ (or grouplist (gnus-server-get-active server nnir-ignored-newsgroups))))
(unless directory
(error "No directory found in method specification of server %s"
server))
@@ -1635,7 +1221,7 @@ construct path: search terms (see the variable
(message "Searching %s using find-grep..."
(or group server))
(save-window-excursion
- (set-buffer (get-buffer-create nnir-tmp-buffer))
+ (set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
(if (> gnus-verbose 6)
(pop-to-buffer (current-buffer)))
(cd directory) ; Using relative paths simplifies
@@ -1702,14 +1288,10 @@ construct path: search terms (see the variable
;;; Util Code:
-(defun gnus-nnir-group-p (group)
- "Say whether GROUP is nnir or not."
- (if (gnus-group-prefixed-p group)
- (eq 'nnir (car (gnus-find-method-for-group group)))
- (and group (string-match "^nnir" group))))
(defun nnir-read-parms (nnir-search-engine)
- "Read additional search parameters according to `nnir-engines'."
+ "Read additional search parameters for NNIR-SEARCH-ENGINE.
+Parameters are according to `nnir-engines'."
(let ((parmspec (nth 2 (assoc nnir-search-engine nnir-engines))))
(mapcar #'nnir-read-parm parmspec)))
@@ -1726,7 +1308,7 @@ PARMSPEC is a cons cell, the car is a symbol, the cdr is a prompt."
(cons sym (read-string prompt)))))
(defun nnir-run-query (specs)
- "Invoke appropriate search engine function (see `nnir-engines')."
+ "Invoke search engine appropriate for SPECS (see `nnir-engines')."
(apply #'vconcat
(mapcar
(lambda (x)
@@ -1735,10 +1317,11 @@ PARMSPEC is a cons cell, the car is a symbol, the cdr is a prompt."
(search-func (cadr (assoc search-engine nnir-engines))))
(and search-func
(funcall search-func (cdr (assq 'nnir-query-spec specs))
- server (cadr x)))))
+ server (cdr x)))))
(cdr (assq 'nnir-group-spec specs)))))
(defun nnir-server-to-search-engine (server)
+ "Find search engine for SERVER."
(or (nnir-read-server-parm 'nnir-search-engine server t)
(cdr (assoc (car (gnus-server-to-method server))
nnir-method-default-engines))))
@@ -1753,163 +1336,41 @@ environment unless NOT-GLOBAL is non-nil."
((and (not not-global) (boundp key)) (symbol-value key))
(t nil))))
-(defun nnir-possibly-change-group (group &optional server)
- (or (not server) (nnir-server-opened server) (nnir-open-server server))
- (when (gnus-nnir-group-p group)
- (setq nnir-artlist (gnus-group-get-parameter
- (gnus-group-prefixed-name
- (gnus-group-short-name group) '(nnir "nnir"))
- 'nnir-artlist t))))
-
-(defun nnir-server-opened (&optional server)
- (let ((backend (car (gnus-server-to-method server))))
- (nnoo-current-server-p (or backend 'nnir) server)))
-
-(autoload 'nnimap-make-thread-query "nnimap")
-(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
-
-(defun nnir-search-thread (header)
- "Make an nnir group based on the thread containing the article HEADER.
-The current server will be searched. If the registry is installed,
-the server that the registry reports the current article came from
-is also searched."
- (let* ((query
- (list (cons 'query (nnimap-make-thread-query header))
- (cons 'criteria "")))
- (server
- (list (list (gnus-method-to-server
- (gnus-find-method-for-group gnus-newsgroup-name)))))
- (registry-group (and
- (bound-and-true-p gnus-registry-enabled)
- (car (gnus-registry-get-id-key
- (mail-header-id header) 'group))))
- (registry-server
- (and registry-group
- (gnus-method-to-server
- (gnus-find-method-for-group registry-group)))))
- (when registry-server
- (cl-pushnew (list registry-server) server :test #'equal))
- (gnus-group-make-nnir-group nil (list
- (cons 'nnir-query-spec query)
- (cons 'nnir-group-spec server)))
- (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
-
-(defun nnir-get-active (srv)
- (let ((method (gnus-server-to-method srv))
- groups)
- (gnus-request-list method)
- (with-current-buffer nntp-server-buffer
- (let ((cur (current-buffer)))
- (goto-char (point-min))
- (unless (or (null nnir-ignored-newsgroups)
- (string= nnir-ignored-newsgroups ""))
- (delete-matching-lines nnir-ignored-newsgroups))
- (if (eq (car method) 'nntp)
- (while (not (eobp))
- (ignore-errors
- (push (gnus-group-full-name
- (buffer-substring
- (point)
- (progn
- (skip-chars-forward "^ \t")
- (point)))
- method)
- groups))
- (forward-line))
- (while (not (eobp))
- (ignore-errors
- (push (if (eq (char-after) ?\")
- (gnus-group-full-name (read cur) method)
- (let ((p (point)) (name ""))
- (skip-chars-forward "^ \t\\\\")
- (setq name (buffer-substring p (point)))
- (while (eq (char-after) ?\\)
- (setq p (1+ (point)))
- (forward-char 2)
- (skip-chars-forward "^ \t\\\\")
- (setq name (concat name (buffer-substring
- p (point)))))
- (gnus-group-full-name name method)))
- groups))
- (forward-line)))))
- groups))
-
-;; Behind gnus-registry-enabled test.
-(declare-function gnus-registry-action "gnus-registry"
- (action data-header from &optional to method))
-
-(defun nnir-registry-action (action data-header _from &optional to method)
- "Call `gnus-registry-action' with the original article group."
- (gnus-registry-action
- action
- data-header
- (nnir-article-group (mail-header-number data-header))
- to
- method))
-
-(defun nnir-mode ()
- (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnir)
- (when (and nnir-summary-line-format
- (not (string= nnir-summary-line-format
- gnus-summary-line-format)))
- (setq gnus-summary-line-format nnir-summary-line-format)
- (gnus-update-format-specifications nil 'summary))
- (when (bound-and-true-p gnus-registry-enabled)
- (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t)
- (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t)
- (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action t)
- (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t)
- (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t)
- (add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t))))
-
-
-(defun gnus-summary-create-nnir-group ()
- (interactive)
- (or (nnir-server-opened "") (nnir-open-server "nnir"))
- (let ((name (gnus-read-group "Group name: "))
- (method '(nnir ""))
- (pgroup
- (gnus-group-guess-full-name-from-command-method gnus-newsgroup-name)))
- (with-current-buffer gnus-group-buffer
- (gnus-group-make-group
- name method nil
- (gnus-group-find-parameter pgroup)))))
-
-
-(deffoo nnir-request-create-group (group &optional _server args)
- (message "Creating nnir group %s" group)
- (let* ((group (gnus-group-prefixed-name group '(nnir "nnir")))
- (specs (assq 'nnir-specs args))
- (query-spec
- (or (cdr (assq 'nnir-query-spec specs))
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))))
- (group-spec
- (or (cdr (assq 'nnir-group-spec specs))
- (list (list (read-string "Server: " nil nil)))))
- (nnir-specs (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec))))
- (gnus-group-set-parameter group 'nnir-specs nnir-specs)
- (gnus-group-set-parameter
- group 'nnir-artlist
- (or (cdr (assq 'nnir-artlist args))
- (nnir-run-query nnir-specs)))
- (nnir-request-update-info group (gnus-get-info group)))
- t)
-
-(deffoo nnir-request-delete-group (_group &optional _force _server)
- t)
-
-(deffoo nnir-request-list (&optional _server)
- t)
-
-(deffoo nnir-request-scan (_group _method)
- t)
-
-(deffoo nnir-request-close ()
- t)
-
-(nnoo-define-skeleton nnir)
+(autoload 'gnus-group-topic-name "gnus-topic" nil nil)
+(defvar gnus-group-marked)
+(defvar gnus-topic-alist)
+
+(make-obsolete 'nnir-make-specs "This function should no longer
+be used." "28.1")
+
+(defun nnir-make-specs (nnir-extra-parms &optional specs)
+ "Make the query-spec and group-spec for a search with NNIR-EXTRA-PARMS.
+Query for the specs, or use SPECS."
+ (let* ((group-spec
+ (or (cdr (assq 'nnir-group-spec specs))
+ (if (gnus-server-server-name)
+ (list (list (gnus-server-server-name)))
+ (seq-group-by
+ (lambda (elt) (gnus-group-server elt))
+ (or gnus-group-marked
+ (if (gnus-group-group-name)
+ (list (gnus-group-group-name))
+ (cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))))))
+ (query-spec
+ (or (cdr (assq 'nnir-query-spec specs))
+ (apply
+ 'append
+ (list (cons 'query
+ (read-string "Query: " nil 'nnir-search-history)))
+ (when nnir-extra-parms
+ (mapcar
+ (lambda (x)
+ (nnir-read-parms (nnir-server-to-search-engine (car x))))
+ group-spec))))))
+ (list (cons 'nnir-query-spec query-spec)
+ (cons 'nnir-group-spec group-spec))))
+
+(define-obsolete-function-alias 'nnir-get-active 'gnus-server-get-active "28.1")
;; The end.
(provide 'nnir)
diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el
deleted file mode 100644
index 95010c00200..00000000000
--- a/lisp/obsolete/old-whitespace.el
+++ /dev/null
@@ -1,801 +0,0 @@
-;;; whitespace.el --- warn about and clean bogus whitespaces in the file
-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
-
-;; Author: Rajesh Vaidheeswarran <rv@gnu.org>
-;; Keywords: convenience
-;; Obsolete-since: 23.1
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; URL: http://www.dsmit.com/lisp/
-;;
-;; The whitespace library is intended to find and help fix five different types
-;; of whitespace problems that commonly exist in source code.
-;;
-;; 1. Leading space (empty lines at the top of a file).
-;; 2. Trailing space (empty lines at the end of a file).
-;; 3. Indentation space (8 or more spaces at beginning of line, that should be
-;; replaced with TABS).
-;; 4. Spaces followed by a TAB. (Almost always, we never want that).
-;; 5. Spaces or TABS at the end of a line.
-;;
-;; Whitespace errors are reported in a buffer, and on the mode line.
-;;
-;; Mode line will show a W:<x>!<y> to denote a particular type of whitespace,
-;; where `x' and `y' can be one (or more) of:
-;;
-;; e - End-of-Line whitespace.
-;; i - Indentation whitespace.
-;; l - Leading whitespace.
-;; s - Space followed by Tab.
-;; t - Trailing whitespace.
-;;
-;; If any of the whitespace checks is turned off, the mode line will display a
-;; !<y>.
-;;
-;; (since (3) is the most controversial one, here is the rationale: Most
-;; terminal drivers and printer drivers have TAB configured or even
-;; hardcoded to be 8 spaces. (Some of them allow configuration, but almost
-;; always they default to 8.)
-;;
-;; Changing `tab-width' to other than 8 and editing will cause your code to
-;; look different from within Emacs, and say, if you cat it or more it, or
-;; even print it.
-;;
-;; Almost all the popular programming modes let you define an offset (like
-;; c-basic-offset or perl-indent-level) to configure the offset, so you
-;; should never have to set your `tab-width' to be other than 8 in all
-;; these modes. In fact, with an indent level of say, 4, 2 TABS will cause
-;; Emacs to replace your 8 spaces with one \t (try it). If vi users in
-;; your office complain, tell them to use vim, which distinguishes between
-;; tabstop and shiftwidth (vi equivalent of our offsets), and also ask them
-;; to set smarttab.)
-;;
-;; All the above have caused (and will cause) unwanted codeline integration and
-;; merge problems.
-;;
-;; whitespace.el will complain if it detects whitespaces on opening a file, and
-;; warn you on closing a file also (in case you had inserted any
-;; whitespaces during the process of your editing).
-;;
-;; Exported functions:
-;;
-;; `whitespace-buffer' - To check the current buffer for whitespace problems.
-;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer.
-;; `whitespace-region' - To check between point and mark for whitespace
-;; problems.
-;; `whitespace-cleanup-region' - To cleanup all whitespaces between point
-;; and mark in the current buffer.
-
-;;; Code:
-
-(defvar whitespace-version "3.5" "Version of the whitespace library.")
-
-(defvar whitespace-all-buffer-files nil
- "An associated list of buffers and files checked for whitespace cleanliness.
-
-This is to enable periodic checking of whitespace cleanliness in the files
-visited by the buffers.")
-
-(defvar whitespace-rescan-timer nil
- "Timer object used to rescan the files in buffers that have been modified.")
-
-;; Tell Emacs about this new kind of minor mode
-(defvar whitespace-mode nil
- "Non-nil when Whitespace mode (a minor mode) is enabled.")
-(make-variable-buffer-local 'whitespace-mode)
-
-(defvar whitespace-mode-line nil
- "String to display in the mode line for Whitespace mode.")
-(make-variable-buffer-local 'whitespace-mode-line)
-
-(defvar whitespace-check-buffer-leading nil
- "Test leading whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-leading)
-;;;###autoload(put 'whitespace-check-buffer-leading 'safe-local-variable 'booleanp)
-
-(defvar whitespace-check-buffer-trailing nil
- "Test trailing whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-trailing)
-;;;###autoload(put 'whitespace-check-buffer-trailing 'safe-local-variable 'booleanp)
-
-(defvar whitespace-check-buffer-indent nil
- "Test indentation whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-indent)
-;;;###autoload(put 'whitespace-check-buffer-indent 'safe-local-variable 'booleanp)
-
-(defvar whitespace-check-buffer-spacetab nil
- "Test Space-followed-by-TABS whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-spacetab)
-;;;###autoload(put 'whitespace-check-buffer-spacetab 'safe-local-variable 'booleanp)
-
-(defvar whitespace-check-buffer-ateol nil
- "Test end-of-line whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-ateol)
-;;;###autoload(put 'whitespace-check-buffer-ateol 'safe-local-variable 'booleanp)
-
-(defvar whitespace-highlighted-space nil
- "The variable to store the extent to highlight.")
-(make-variable-buffer-local 'whitespace-highlighted-space)
-
-(defalias 'whitespace-make-overlay
- (if (featurep 'xemacs) 'make-extent 'make-overlay))
-(defalias 'whitespace-overlay-put
- (if (featurep 'xemacs) 'set-extent-property 'overlay-put))
-(defalias 'whitespace-delete-overlay
- (if (featurep 'xemacs) 'delete-extent 'delete-overlay))
-(defalias 'whitespace-overlay-start
- (if (featurep 'xemacs) 'extent-start 'overlay-start))
-(defalias 'whitespace-overlay-end
- (if (featurep 'xemacs) 'extent-end 'overlay-end))
-(defalias 'whitespace-mode-line-update
- (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update))
-
-(defgroup whitespace nil
- "Check for and fix five different types of whitespaces in source code."
- :version "21.1"
- :link '(emacs-commentary-link "whitespace.el")
- ;; Since XEmacs doesn't have a 'convenience group, use the next best group
- ;; which is 'editing?
- :group (if (featurep 'xemacs) 'editing 'convenience))
-
-(defcustom whitespace-check-leading-whitespace t
- "Flag to check leading whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-leading'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-check-trailing-whitespace t
- "Flag to check trailing whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-trailing'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-check-spacetab-whitespace t
- "Flag to check space followed by a TAB. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-spacetab'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-spacetab-regexp "[ ]+\t"
- "Regexp to match one or more spaces followed by a TAB."
- :type 'regexp
- :group 'whitespace)
-
-(defcustom whitespace-check-indent-whitespace indent-tabs-mode
- "Flag to check indentation whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-indent'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-indent-regexp "^\t*\\( \\)+"
- "Regexp to match multiples of eight spaces near line beginnings.
-The default value ignores leading TABs."
- :type 'regexp
- :group 'whitespace)
-
-(defcustom whitespace-check-ateol-whitespace t
- "Flag to check end-of-line whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-ateol'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-ateol-regexp "[ \t]+$"
- "Regexp to match one or more TABs or spaces at line ends."
- :type 'regexp
- :group 'whitespace)
-
-(defcustom whitespace-errbuf "*Whitespace Errors*"
- "The name of the buffer where whitespace related messages will be logged."
- :type 'string
- :group 'whitespace)
-
-(defcustom whitespace-clean-msg "clean."
- "If non-nil, this message will be displayed after a whitespace check
-determines a file to be clean."
- :type 'string
- :group 'whitespace)
-
-(defcustom whitespace-abort-on-error nil
- "While writing a file, abort if the file is unclean.
-If `whitespace-auto-cleanup' is set, that takes precedence over
-this variable."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-auto-cleanup nil
- "Cleanup a buffer automatically on finding it whitespace unclean."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-silent nil
- "All whitespace errors will be shown only in the mode line when t.
-
-Note that setting this may cause all whitespaces introduced in a file to go
-unnoticed when the buffer is killed, unless the user visits the `*Whitespace
-Errors*' buffer before opening (or closing) another file."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode
- c-mode c++-mode cc-mode
- change-log-mode cperl-mode
- electric-nroff-mode emacs-lisp-mode
- f90-mode fortran-mode html-mode
- html3-mode java-mode jde-mode
- ksh-mode latex-mode LaTeX-mode
- lisp-mode m4-mode makefile-mode
- modula-2-mode nroff-mode objc-mode
- pascal-mode perl-mode prolog-mode
- python-mode scheme-mode sgml-mode
- sh-mode shell-script-mode simula-mode
- tcl-mode tex-mode texinfo-mode
- vrml-mode xml-mode)
-
- "Major modes in which we turn on whitespace checking.
-
-These are mostly programming and documentation modes. But you may add other
-modes that you want whitespaces checked in by adding something like the
-following to your `.emacs':
-
-\(setq whitespace-modes (cons \\='my-mode (cons \\='my-other-mode
- whitespace-modes))\)
-
-Or, alternately, you can use the Emacs `customize' command to set this."
- :type '(repeat symbol)
- :group 'whitespace)
-
-(defcustom whitespace-rescan-timer-time 600
- "Period in seconds to rescan modified buffers for whitespace creep.
-
-This is the period after which the timer will fire causing
-`whitespace-rescan-files-in-buffers' to check for whitespace creep in
-modified buffers.
-
-To disable timer scans, set this to zero."
- :type 'integer
- :group 'whitespace)
-
-(defcustom whitespace-display-in-modeline t
- "Display whitespace errors on the modeline."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-display-spaces-in-color t
- "Display the bogus whitespaces by coloring them with the face
-`whitespace-highlight'."
- :type 'boolean
- :group 'whitespace)
-
-(defface whitespace-highlight '((((class color) (background light))
- (:background "green1"))
- (((class color) (background dark))
- (:background "sea green"))
- (((class grayscale mono)
- (background light))
- (:background "black"))
- (((class grayscale mono)
- (background dark))
- (:background "white")))
- "Face used for highlighting the bogus whitespaces that exist in the buffer."
- :group 'whitespace)
-
-(if (not (assoc 'whitespace-mode minor-mode-alist))
- (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line)
- minor-mode-alist)))
-
-(set-default 'whitespace-check-buffer-leading
- whitespace-check-leading-whitespace)
-(set-default 'whitespace-check-buffer-trailing
- whitespace-check-trailing-whitespace)
-(set-default 'whitespace-check-buffer-indent
- whitespace-check-indent-whitespace)
-(set-default 'whitespace-check-buffer-spacetab
- whitespace-check-spacetab-whitespace)
-(set-default 'whitespace-check-buffer-ateol
- whitespace-check-ateol-whitespace)
-
-(defun whitespace-check-whitespace-mode (&optional arg)
- "Test and set the whitespace-mode in qualifying buffers."
- (if (null whitespace-mode)
- (setq whitespace-mode
- (if (or arg (member major-mode whitespace-modes))
- t
- nil))))
-
-;;;###autoload
-(defun whitespace-toggle-leading-check ()
- "Toggle the check for leading space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-leading))
- (setq whitespace-check-buffer-leading (not current-val))
- (message "Will%s check for leading space in buffer."
- (if whitespace-check-buffer-leading "" " not"))
- (if whitespace-check-buffer-leading (whitespace-buffer-leading))))
-
-;;;###autoload
-(defun whitespace-toggle-trailing-check ()
- "Toggle the check for trailing space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-trailing))
- (setq whitespace-check-buffer-trailing (not current-val))
- (message "Will%s check for trailing space in buffer."
- (if whitespace-check-buffer-trailing "" " not"))
- (if whitespace-check-buffer-trailing (whitespace-buffer-trailing))))
-
-;;;###autoload
-(defun whitespace-toggle-indent-check ()
- "Toggle the check for indentation space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-indent))
- (setq whitespace-check-buffer-indent (not current-val))
- (message "Will%s check for indentation space in buffer."
- (if whitespace-check-buffer-indent "" " not"))
- (if whitespace-check-buffer-indent
- (whitespace-buffer-search whitespace-indent-regexp))))
-
-;;;###autoload
-(defun whitespace-toggle-spacetab-check ()
- "Toggle the check for space-followed-by-TABs in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-spacetab))
- (setq whitespace-check-buffer-spacetab (not current-val))
- (message "Will%s check for space-followed-by-TABs in buffer."
- (if whitespace-check-buffer-spacetab "" " not"))
- (if whitespace-check-buffer-spacetab
- (whitespace-buffer-search whitespace-spacetab-regexp))))
-
-
-;;;###autoload
-(defun whitespace-toggle-ateol-check ()
- "Toggle the check for end-of-line space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-ateol))
- (setq whitespace-check-buffer-ateol (not current-val))
- (message "Will%s check for end-of-line space in buffer."
- (if whitespace-check-buffer-ateol "" " not"))
- (if whitespace-check-buffer-ateol
- (whitespace-buffer-search whitespace-ateol-regexp))))
-
-
-;;;###autoload
-(defun whitespace-buffer (&optional quiet)
- "Find five different types of white spaces in buffer.
-These are:
-1. Leading space \(empty lines at the top of a file\).
-2. Trailing space \(empty lines at the end of a file\).
-3. Indentation space \(8 or more spaces, that should be replaced with TABS\).
-4. Spaces followed by a TAB. \(Almost always, we never want that\).
-5. Spaces or TABS at the end of a line.
-
-Check for whitespace only if this buffer really contains a non-empty file
-and:
-1. the major mode is one of the whitespace-modes, or
-2. `whitespace-buffer' was explicitly called with a prefix argument."
- (interactive)
- (let ((whitespace-error nil))
- (whitespace-check-whitespace-mode current-prefix-arg)
- (if (and buffer-file-name (> (buffer-size) 0) whitespace-mode)
- (progn
- (whitespace-check-buffer-list (buffer-name) buffer-file-name)
- (whitespace-tickle-timer)
- (overlay-recenter (point-max))
- (remove-overlays nil nil 'face 'whitespace-highlight)
- (if whitespace-auto-cleanup
- (if buffer-read-only
- (if (not quiet)
- (message "Can't cleanup: %s is read-only" (buffer-name)))
- (whitespace-cleanup-internal))
- (let ((whitespace-leading (if whitespace-check-buffer-leading
- (whitespace-buffer-leading)
- nil))
- (whitespace-trailing (if whitespace-check-buffer-trailing
- (whitespace-buffer-trailing)
- nil))
- (whitespace-indent (if whitespace-check-buffer-indent
- (whitespace-buffer-search
- whitespace-indent-regexp)
- nil))
- (whitespace-spacetab (if whitespace-check-buffer-spacetab
- (whitespace-buffer-search
- whitespace-spacetab-regexp)
- nil))
- (whitespace-ateol (if whitespace-check-buffer-ateol
- (whitespace-buffer-search
- whitespace-ateol-regexp)
- nil))
- (whitespace-errmsg nil)
- (whitespace-filename buffer-file-name)
- (whitespace-this-modeline ""))
-
- ;; Now let's complain if we found any of the above.
- (setq whitespace-error (or whitespace-leading whitespace-indent
- whitespace-spacetab whitespace-ateol
- whitespace-trailing))
-
- (if whitespace-error
- (progn
- (setq whitespace-errmsg
- (concat whitespace-filename " contains:\n"
- (if whitespace-leading
- "Leading whitespace\n")
- (if whitespace-indent
- (concat "Indentation whitespace"
- whitespace-indent "\n"))
- (if whitespace-spacetab
- (concat "Space followed by Tab"
- whitespace-spacetab "\n"))
- (if whitespace-ateol
- (concat "End-of-line whitespace"
- whitespace-ateol "\n"))
- (if whitespace-trailing
- "Trailing whitespace\n")
- "\ntype `M-x whitespace-cleanup' to "
- "cleanup the file."))
- (setq whitespace-this-modeline
- (concat (if whitespace-ateol "e")
- (if whitespace-indent "i")
- (if whitespace-leading "l")
- (if whitespace-spacetab "s")
- (if whitespace-trailing "t")))))
- (whitespace-update-modeline whitespace-this-modeline)
- (if (get-buffer whitespace-errbuf)
- (kill-buffer whitespace-errbuf))
- (with-current-buffer (get-buffer-create whitespace-errbuf)
- (if whitespace-errmsg
- (progn
- (insert whitespace-errmsg)
- (if (not (or quiet whitespace-silent))
- (display-buffer (current-buffer) t))
- (if (not quiet)
- (message "Whitespaces: [%s%s] in %s"
- whitespace-this-modeline
- (let ((whitespace-unchecked
- (whitespace-unchecked-whitespaces)))
- (if whitespace-unchecked
- (concat "!" whitespace-unchecked)
- ""))
- whitespace-filename)))
- (if (and (not quiet) (not (equal whitespace-clean-msg "")))
- (message "%s %s" whitespace-filename
- whitespace-clean-msg))))))))
- whitespace-error))
-
-;;;###autoload
-(defun whitespace-region (s e)
- "Check the region for whitespace errors."
- (interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region s e)
- (whitespace-buffer))))
-
-;;;###autoload
-(defun whitespace-cleanup ()
- "Cleanup the five different kinds of whitespace problems.
-It normally applies to the whole buffer, but in Transient Mark mode
-when the mark is active it applies to the region.
-See `whitespace-buffer' docstring for a summary of the problems."
- (interactive)
- (if (and transient-mark-mode mark-active)
- (whitespace-cleanup-region (region-beginning) (region-end))
- (whitespace-cleanup-internal)))
-
-(defun whitespace-cleanup-internal (&optional region-only)
- ;; If this buffer really contains a file, then run, else quit.
- (whitespace-check-whitespace-mode current-prefix-arg)
- (if (and buffer-file-name whitespace-mode)
- (let ((whitespace-any nil)
- (whitespace-tabwidth 8)
- (whitespace-tabwidth-saved tab-width))
-
- ;; since all printable TABS should be 8, irrespective of how
- ;; they are displayed.
- (setq tab-width whitespace-tabwidth)
-
- (if (and whitespace-check-buffer-leading
- (whitespace-buffer-leading))
- (progn
- (whitespace-buffer-leading-cleanup)
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-trailing
- (whitespace-buffer-trailing))
- (progn
- (whitespace-buffer-trailing-cleanup)
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-indent
- (whitespace-buffer-search whitespace-indent-regexp))
- (progn
- (whitespace-indent-cleanup)
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-spacetab
- (whitespace-buffer-search whitespace-spacetab-regexp))
- (progn
- (whitespace-buffer-cleanup whitespace-spacetab-regexp "\t")
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-ateol
- (whitespace-buffer-search whitespace-ateol-regexp))
- (progn
- (whitespace-buffer-cleanup whitespace-ateol-regexp "")
- (setq whitespace-any t)))
-
- ;; Call this recursively till everything is taken care of
- (if whitespace-any
- (whitespace-cleanup-internal region-only)
- ;; if we are done, talk to the user
- (progn
- (unless whitespace-silent
- (if region-only
- (message "The region is now clean")
- (message "%s is now clean" buffer-file-name)))
- (whitespace-update-modeline)))
- (setq tab-width whitespace-tabwidth-saved))))
-
-;;;###autoload
-(defun whitespace-cleanup-region (s e)
- "Whitespace cleanup on the region."
- (interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region s e)
- (whitespace-cleanup-internal t))
- (whitespace-buffer t)))
-
-(defun whitespace-buffer-leading ()
- "Return t if the current buffer has leading newline characters.
-If highlighting is enabled, highlight these characters."
- (save-excursion
- (goto-char (point-min))
- (skip-chars-forward "\n")
- (unless (bobp)
- (whitespace-highlight-the-space (point-min) (point))
- t)))
-
-(defun whitespace-buffer-leading-cleanup ()
- "Remove any leading newline characters from current buffer."
- (save-excursion
- (goto-char (point-min))
- (skip-chars-forward "\n")
- (delete-region (point-min) (point))))
-
-(defun whitespace-buffer-trailing ()
- "Return t if the current buffer has extra trailing newline characters.
-If highlighting is enabled, highlight these characters."
- (save-excursion
- (goto-char (point-max))
- (skip-chars-backward "\n")
- (forward-line)
- (unless (eobp)
- (whitespace-highlight-the-space (point) (point-max))
- t)))
-
-(defun whitespace-buffer-trailing-cleanup ()
- "Remove extra trailing newline characters from current buffer."
- (save-excursion
- (goto-char (point-max))
- (skip-chars-backward "\n")
- (unless (eobp)
- (forward-line)
- (delete-region (point) (point-max)))))
-
-(defun whitespace-buffer-search (regexp)
- "Search for any given whitespace REGEXP."
- (with-local-quit
- (let (whitespace-retval)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (whitespace-highlight-the-space (match-beginning 0) (match-end 0))
- (push (match-beginning 0) whitespace-retval)))
- (when whitespace-retval
- (format " %s" (nreverse whitespace-retval))))))
-
-(defun whitespace-buffer-cleanup (regexp newregexp)
- "Search for any given whitespace REGEXP and replace it with the NEWREGEXP."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (replace-match newregexp))))
-
-(defun whitespace-indent-cleanup ()
- "Search for 8/more spaces at the start of a line and replace it with tabs."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward whitespace-indent-regexp nil t)
- (let ((column (current-column))
- (indent-tabs-mode t))
- (delete-region (match-beginning 0) (point))
- (indent-to column)))))
-
-(defun whitespace-unchecked-whitespaces ()
- "Return the list of whitespaces whose testing has been suppressed."
- (let ((unchecked-spaces
- (concat (if (not whitespace-check-buffer-ateol) "e")
- (if (not whitespace-check-buffer-indent) "i")
- (if (not whitespace-check-buffer-leading) "l")
- (if (not whitespace-check-buffer-spacetab) "s")
- (if (not whitespace-check-buffer-trailing) "t"))))
- (if (not (equal unchecked-spaces ""))
- unchecked-spaces
- nil)))
-
-(defun whitespace-update-modeline (&optional whitespace-err)
- "Update mode line with whitespace errors.
-Also with whitespaces whose testing has been turned off."
- (if whitespace-display-in-modeline
- (progn
- (setq whitespace-mode-line nil)
- ;; Whitespace errors
- (if (and whitespace-err (not (equal whitespace-err "")))
- (setq whitespace-mode-line whitespace-err))
- ;; Whitespace suppressed errors
- (let ((whitespace-unchecked (whitespace-unchecked-whitespaces)))
- (if whitespace-unchecked
- (setq whitespace-mode-line
- (concat whitespace-mode-line "!" whitespace-unchecked))))
- ;; Add the whitespace modeline prefix
- (setq whitespace-mode-line (if whitespace-mode-line
- (concat " W:" whitespace-mode-line)
- nil))
- (whitespace-mode-line-update))))
-
-(defun whitespace-highlight-the-space (b e)
- "Highlight the current line, unhighlighting a previously jumped to line."
- (if whitespace-display-spaces-in-color
- (let ((ol (whitespace-make-overlay b e)))
- (whitespace-overlay-put ol 'face 'whitespace-highlight))))
-
-(defun whitespace-unhighlight-the-space()
- "Unhighlight the currently highlight line."
- (if (and whitespace-display-spaces-in-color whitespace-highlighted-space)
- (progn
- (mapc 'whitespace-delete-overlay whitespace-highlighted-space)
- (setq whitespace-highlighted-space nil))))
-
-(defun whitespace-check-buffer-list (buf-name buf-file)
- "Add a buffer and its file to the whitespace monitor list.
-
-The buffer named BUF-NAME and its associated file BUF-FILE are now monitored
-periodically for whitespace."
- (if (and whitespace-mode (not (member (list buf-file buf-name)
- whitespace-all-buffer-files)))
- (add-to-list 'whitespace-all-buffer-files (list buf-file buf-name))))
-
-(defun whitespace-tickle-timer ()
- "Tickle timer to periodically to scan qualifying files for whitespace creep.
-
-If timer is not set, then set it to scan the files in
-`whitespace-all-buffer-files' periodically (defined by
-`whitespace-rescan-timer-time') for whitespace creep."
- (if (and whitespace-rescan-timer-time
- (/= whitespace-rescan-timer-time 0)
- (not whitespace-rescan-timer))
- (setq whitespace-rescan-timer
- (add-timeout whitespace-rescan-timer-time
- 'whitespace-rescan-files-in-buffers nil
- whitespace-rescan-timer-time))))
-
-(defun whitespace-rescan-files-in-buffers (&optional arg)
- "Check monitored files for whitespace creep since last scan."
- (let ((whitespace-all-my-files whitespace-all-buffer-files)
- buffile bufname thiselt buf)
- (if (not whitespace-all-my-files)
- (progn
- (disable-timeout whitespace-rescan-timer)
- (setq whitespace-rescan-timer nil))
- (while whitespace-all-my-files
- (setq thiselt (car whitespace-all-my-files))
- (setq whitespace-all-my-files (cdr whitespace-all-my-files))
- (setq buffile (car thiselt))
- (setq bufname (cadr thiselt))
- (setq buf (get-buffer bufname))
- (if (buffer-live-p buf)
- (with-current-buffer bufname
- ;;(message "buffer %s live" bufname)
- (if whitespace-mode
- (progn
- ;;(message "checking for whitespace in %s" bufname)
- (if whitespace-auto-cleanup
- (progn
- ;;(message "cleaning up whitespace in %s" bufname)
- (whitespace-cleanup-internal))
- (progn
- ;;(message "whitespace-buffer %s." (buffer-name))
- (whitespace-buffer t))))
- ;;(message "Removing %s from refresh list" bufname)
- (whitespace-refresh-rescan-list buffile bufname)))
- ;;(message "Removing %s from refresh list" bufname)
- (whitespace-refresh-rescan-list buffile bufname))))))
-
-(defun whitespace-refresh-rescan-list (buffile bufname)
- "Refresh the list of files to be rescanned for whitespace creep."
- (if whitespace-all-buffer-files
- (setq whitespace-all-buffer-files
- (delete (list buffile bufname) whitespace-all-buffer-files))
- (when whitespace-rescan-timer
- (disable-timeout whitespace-rescan-timer)
- (setq whitespace-rescan-timer nil))))
-
-;;;###autoload
-(defalias 'global-whitespace-mode 'whitespace-global-mode)
-
-;;;###autoload
-(define-minor-mode whitespace-global-mode
- "Toggle using Whitespace mode in new buffers.
-
-When this mode is active, `whitespace-buffer' is added to
-`find-file-hook' and `kill-buffer-hook'."
- :global t
- :group 'whitespace
- (if whitespace-global-mode
- (progn
- (add-hook 'find-file-hook 'whitespace-buffer)
- (add-hook 'write-file-functions 'whitespace-write-file-hook nil t)
- (add-hook 'kill-buffer-hook 'whitespace-buffer))
- (remove-hook 'find-file-hook 'whitespace-buffer)
- (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
- (remove-hook 'kill-buffer-hook 'whitespace-buffer)))
-
-;;;###autoload
-(defun whitespace-write-file-hook ()
- "Hook function to be called on the buffer when whitespace check is enabled.
-This is meant to be added buffer-locally to `write-file-functions'."
- (let ((werr nil))
- (if whitespace-auto-cleanup
- (whitespace-cleanup-internal)
- (setq werr (whitespace-buffer)))
- (if (and whitespace-abort-on-error werr)
- (error "Abort write due to whitespaces in %s"
- buffer-file-name)))
- nil)
-
-(defun whitespace-unload-function ()
- "Unload the whitespace library."
- (if (unintern "whitespace-unload-hook" obarray)
- ;; if whitespace-unload-hook is defined, let's get rid of it
- ;; and recursively call `unload-feature'
- (progn (unload-feature 'whitespace) t)
- ;; this only happens in the recursive call
- (whitespace-global-mode -1)
- (save-current-buffer
- (dolist (buf (buffer-list))
- (set-buffer buf)
- (remove-hook 'write-file-functions 'whitespace-write-file-hook t)))
- ;; continue standard unloading
- nil))
-
-(defun whitespace-unload-hook ()
- (remove-hook 'find-file-hook 'whitespace-buffer)
- (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
- (remove-hook 'kill-buffer-hook 'whitespace-buffer))
-
-(add-hook 'whitespace-unload-hook 'whitespace-unload-hook)
-
-(provide 'whitespace)
-
-;;; whitespace.el ends here
diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el
index 5ef8be20d98..6d95b7136b1 100644
--- a/lisp/obsolete/rcompile.el
+++ b/lisp/obsolete/rcompile.el
@@ -89,7 +89,7 @@ nil means use the value returned by \\[user-login-name]."
"Command to run before compilation.
This can be used for setting up environment variables,
since rsh does not invoke the shell as a login shell and files like .login
-\(tcsh\) and .bash_profile \(bash\) are not run.
+\(tcsh) and .bash_profile \(bash) are not run.
nil means run no commands."
:type '(choice string (const nil))
:group 'remote-compile)
diff --git a/lisp/obsolete/sb-image.el b/lisp/obsolete/sb-image.el
new file mode 100644
index 00000000000..fd8884738d4
--- /dev/null
+++ b/lisp/obsolete/sb-image.el
@@ -0,0 +1,46 @@
+;;; sb-image --- Image management for speedbar
+
+;; Copyright (C) 1999-2003, 2005-2019 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Keywords: file, tags, tools
+;; Obsolete-since: 28.1
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file is obsolete.
+;;
+;; Supporting Image display for Emacs 20 and less, Emacs 21, and XEmacs,
+;; is a challenging task, which doesn't take kindly to being byte compiled.
+;; When sharing speedbar.elc between these three applications, the Image
+;; support can get lost.
+;;
+;; By splitting out that hard part into this file, and avoiding byte
+;; compilation, one copy speedbar can support all these platforms together.
+;;
+;; This file requires the `image' package if it is available.
+
+(require 'ezimage)
+
+;;; Code:
+
+(defalias 'defimage-speedbar 'defezimage)
+
+(provide 'sb-image)
+
+;;; sb-image.el ends here
diff --git a/lisp/obsolete/tls.el b/lisp/obsolete/tls.el
index cd091c0108e..d1b215cbfb8 100644
--- a/lisp/obsolete/tls.el
+++ b/lisp/obsolete/tls.el
@@ -47,9 +47,6 @@
(require 'gnutls)
-(autoload 'format-spec "format-spec")
-(autoload 'format-spec-make "format-spec")
-
(defgroup tls nil
"Transport Layer Security (TLS) parameters."
:group 'comm)
@@ -224,14 +221,11 @@ Fourth arg PORT is an integer specifying a port to connect to."
(while (and (not done) (setq cmd (pop cmds)))
(let ((process-connection-type tls-process-connection-type)
(formatted-cmd
- (format-spec
- cmd
- (format-spec-make
- ?t (car (gnutls-trustfiles))
- ?h host
- ?p (if (integerp port)
- (int-to-string port)
- port)))))
+ (format-spec cmd `((?t . ,(car (gnutls-trustfiles)))
+ (?h . ,host)
+ (?p . ,(if (integerp port)
+ (number-to-string port)
+ port))))))
(message "Opening TLS connection with `%s'..." formatted-cmd)
(setq process (start-process
name buffer shell-file-name shell-command-switch
diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el
index d71f79c87be..0de7aa096d6 100644
--- a/lisp/obsolete/tpu-edt.el
+++ b/lisp/obsolete/tpu-edt.el
@@ -287,14 +287,6 @@
;;;
;;; User Configurable Variables
;;;
-(defcustom tpu-have-ispell t
- "Non-nil means `tpu-spell-check' uses `ispell-region' for spell checking.
-Otherwise, use `spell-region'."
- :type 'boolean
- :group 'tpu)
-(make-obsolete-variable 'tpu-have-ispell "the `spell' package is obsolete."
- "23.1")
-
(defcustom tpu-kill-buffers-silently nil
"If non-nil, TPU-edt kills modified buffers without asking."
:type 'boolean
@@ -315,7 +307,6 @@ Otherwise, use `spell-region'."
;;; Global Keymaps
;;;
-(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1")
(defvar tpu-gold-map
(let ((map (make-keymap)))
;; Previously we used escape sequences here. We now instead presume
@@ -892,8 +883,7 @@ With argument, fill and justify."
if no region is selected."
(interactive)
(let ((m (tpu-mark)))
- (apply (if tpu-have-ispell 'ispell-region
- 'spell-region)
+ (apply 'ispell-region
(if m
(if (> m (point)) (list (point) m)
(list m (point)))
diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el
index bcdefac5187..93bd991eb3a 100644
--- a/lisp/obsolete/vc-arch.el
+++ b/lisp/obsolete/vc-arch.el
@@ -597,20 +597,21 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
(unless (file-writable-p rl-dir)
(error "No writable revlib directory found"))
(message "Revlib at %s" rl-dir)
- (let* ((archives (directory-files rl-dir 'full (rx (or (not ".") "..."))))
+ (let* ((archives (directory-files rl-dir 'full
+ directory-files-no-dot-files-regexp))
(categories
(apply 'append
(mapcar (lambda (dir)
(when (file-directory-p dir)
- (directory-files dir 'full
- (rx (or (not ".") "...")))))
+ (directory-files
+ dir 'full directory-files-no-dot-files-regexp)))
archives)))
(branches
(apply 'append
(mapcar (lambda (dir)
(when (file-directory-p dir)
- (directory-files dir 'full
- (rx (or (not ".") "...")))))
+ (directory-files
+ dir 'full directory-files-no-dot-files-regexp)))
categories)))
(versions
(apply 'append
diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el
index df5ddfdbcf9..eee00b43a26 100644
--- a/lisp/obsolete/vi.el
+++ b/lisp/obsolete/vi.el
@@ -1225,7 +1225,7 @@ SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)."
(defun vi-end-of-blank-delimited-word (count)
"Forward to the end of the COUNT'th blank-delimited word."
(interactive "p")
- (if (re-search-forward "[^ \t\n\']+[ \t\n\']" nil t count)
+ (if (re-search-forward "[^ \t\n']+[ \t\n']" nil t count)
(if (not (eobp)) (backward-char 2))))
(defun vi-home-window-line (arg)
diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el
index 4a9b8fff264..37defd1c5a4 100644
--- a/lisp/obsolete/vip.el
+++ b/lisp/obsolete/vip.el
@@ -80,7 +80,7 @@
(defvar vip-current-major-mode nil
"vip-current-major-mode is the major-mode vi considers it is now.
-\(buffer specific\)")
+\(buffer specific)")
(make-variable-buffer-local 'vip-current-major-mode)
@@ -1510,7 +1510,7 @@ used. This behavior is controlled by the sign of prefix numeric value."
(* (/ (point-max) 100) arg)
(/ (* (point-max) arg) 100)))
(back-to-indentation))
- (cond ((looking-at "[\(\[{]")
+ (cond ((looking-at "[([{]")
(if com (move-marker vip-com-point (point)))
(forward-sexp 1)
(if com
@@ -1719,7 +1719,7 @@ STRING. Search will be forward if FORWARD, otherwise backward."
(let (buffer)
(setq buffer
(read-buffer
- (format "switch to buffer \(%s\): "
+ (format "switch to buffer (%s): "
(buffer-name (other-buffer (current-buffer))))))
(switch-to-buffer buffer)
(vip-change-mode-to-vi)))
@@ -1730,7 +1730,7 @@ STRING. Search will be forward if FORWARD, otherwise backward."
(let (buffer)
(setq buffer
(read-buffer
- (format "Switch to buffer \(%s\): "
+ (format "Switch to buffer (%s): "
(buffer-name (other-buffer (current-buffer))))))
(switch-to-buffer-other-window buffer)
(vip-change-mode-to-vi)))
@@ -1741,7 +1741,7 @@ STRING. Search will be forward if FORWARD, otherwise backward."
(let (buffer buffer-name)
(setq buffer-name
(read-buffer
- (format "Kill buffer \(%s\): "
+ (format "Kill buffer (%s): "
(buffer-name (current-buffer)))))
(setq buffer
(if (null buffer-name)
@@ -2162,7 +2162,7 @@ is a command.")
(defun vip-get-ex-token ()
"get an ex-token which is either an address or a command.
-a token has type \(command, address, end-mark\) and value."
+a token has type \(command, address, end-mark) and value."
(with-current-buffer " *ex-working-space*"
(skip-chars-forward " \t")
(cond ((looking-at "[k#]")
@@ -2668,7 +2668,7 @@ a token has type \(command, address, end-mark\) and value."
"ex-edit"
(vip-get-ex-file)
(if (and (not ex-variant) (buffer-modified-p) buffer-file-name)
- (error "No write since last change \(:e! overrides\)"))
+ (error "No write since last change (:e! overrides)"))
(vip-change-mode-to-emacs)
(set-buffer
(find-file-noselect (concat default-directory ex-file)))
diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1
index 65d60bee11d..ef62ae7356c 100644
--- a/lisp/org/ChangeLog.1
+++ b/lisp/org/ChangeLog.1
@@ -1615,7 +1615,7 @@
(org-babel-load-in-session-maybe, org-babel-pop-to-session-maybe):
Use it.
(org-babel-execute-src-block): Use `copy-tree' to prevent setf
- from modifying users variables withing let-bound `info' variable.
+ from modifying users variables within let-bound `info' variable.
* ob-exp.el (org-export-babel-evaluate): Add a 'inline-only
option.
@@ -1821,7 +1821,7 @@
it is an ARRAY ref, otherwise print it without a final newline.
(org-babel-perl-preface): Content of this variable is prepended to
body before invocation of perl. Rename input parameter body to
- ibody and let-bind body to concatentation of
+ ibody and let-bind body to concatenation of
`org-babel-perl-preface' and ibody. Implement results
interpretation so that tables are easier to produce.
@@ -3142,7 +3142,7 @@
relatively to the current timestamp, not to today's date.
* org-agenda.el (org-agenda-filter-apply):
- Deactive `org-agenda-entry-text-mode' when filtering.
+ Deactivate `org-agenda-entry-text-mode' when filtering.
(org-agenda-entry-text-mode): Don't allow in filtered views.
Don't show the maximum number of lines when turning off.
@@ -3439,7 +3439,7 @@
(org-edit-src-exit): Cancel the timer.
(org-edit-src-save): Prevent saving when editing fixed-width
buffer, exiting will save already.
- (org-edit-src-exit): Inconditionally kill the src/example
+ (org-edit-src-exit): Unconditionally kill the src/example
editing buffer.
* org-pcomplete.el (pcomplete/org-mode/file-option):
@@ -3490,7 +3490,7 @@
* org-pcomplete.el (pcomplete/org-mode/file-option/x):
Resurrect. Use `org-default-options' to initialize completion
- fonctions for the most important keywords.
+ functions for the most important keywords.
* org-macs.el (org-default-options): Rename and adapt from
`org-get-current-options'.
@@ -3588,7 +3588,7 @@
new sorting strategies.
(org-agenda-get-todos, org-agenda-get-timestamps)
(org-agenda-get-deadlines, org-agenda-get-scheduled): Add a
- `ts-date' text property with scheduled, deadline or timetamp
+ `ts-date' text property with scheduled, deadline or timestamp
date.
(org-cmp-ts): New function to compare timestamps.
(org-em): Add a docstring.
@@ -4800,7 +4800,7 @@
(org-element-timestamp-interpreter): Parse warning delays.
* ox-beamer.el (org-beamer--format-section): Fix regression which
- prevents frames from being propely exported.
+ prevents frames from being properly exported.
* ox.el (org-export-with-backend): Ensure function will use
provided back-end.
@@ -4888,7 +4888,7 @@
which is always nil in this back-end.
* org.el (org-adaptive-fill-function): Look for a fill prefix at
- the beginning of the paragraph and subsquently on its second line
+ the beginning of the paragraph and subsequently on its second line
instead of the current line.
* ob-core.el (org-babel-get-src-block-info): Look for indentation
@@ -5595,7 +5595,7 @@
(org-export-async-start): Do not call `org-mode' since this is done
already in the previous function.
- * ox-beamer.el (org-beamer-keyword): Remove frame arount toc when
+ * ox-beamer.el (org-beamer-keyword): Remove frame around toc when
generated from a TOC keyword.
* org.el (org-export-backends): Do not reset list of loaded
@@ -5629,7 +5629,7 @@
during a body-only export.
* ox.el (org-export-as): Store export options in :export-options
- porperty within communication channel.
+ property within communication channel.
* ox-latex.el (org-latex-item): Fix wrong behavior when a counter
is set in an ordered list while its parent is not ordered.
@@ -5714,7 +5714,7 @@
(org-create-formula-image-with-dvipng)
(org-create-formula-image-with-imagemagick): Use new function.
- * ox.el (org-export-get-previous-element): Change order of retured
+ * ox.el (org-export-get-previous-element): Change order of returned
elements in `org-export-get-previous-element'.
* org-element.el (org-element-all-successors): Add `plain-link'
@@ -5839,10 +5839,10 @@
Remove reference to now renamed `e-ascii' back-end.
* ox-beamer.el (org-beamer-template): Allow to span documentclass
- options accross multiple lines in template.
+ options across multiple lines in template.
* ox-latex.el (org-latex-template): Allow to span documentclass
- options accross multiple lines in template.
+ options across multiple lines in template.
* ox-texinfo.el (org-texinfo--get-node): Upcase property name.
(org-texinfo--get-node): New function.
@@ -6524,7 +6524,7 @@
* org.el (org-open-at-point): The new code is being run in the
same spot as `org-open-link-functions'. In case they failed,
check if link matches "^id:" and if so, load the id interface and
- follwo the link.
+ follow the link.
2013-11-12 Rasmus Pank Roulund <rasmus@gmx.us> (tiny change)
@@ -6717,7 +6717,7 @@
2013-11-12 Vitalie Spinu <spinuvit@gmail.com>
* ob-tangle.el (org-babel-find-file-noselect-refresh):
- Call `find-file-noselect' with 'nowarn argument to surpress
+ Call `find-file-noselect' with 'nowarn argument to suppress
`yes-or-no-p' reversion message.
* ob-core.el (org-babel-where-is-src-block-head):
@@ -6990,7 +6990,7 @@
docstrings. Also fix typos.
* org-list.el (org-list-struct-fix-box): When a checkbox has to be
- resetted because of a non-nil ORDERED property value, make sure it
+ reset because of a non-nil ORDERED property value, make sure it
had a checkbox already.
2013-02-07 Tokuya Kameshima <kametoku@gmail.com> (tiny change)
@@ -9533,7 +9533,7 @@
* org-latex.el (org-export-latex-make-header): Ditto.
* org-clock.el (org-clocktable-write-default): Temporarily disable
- `delete-active-region' so that we don't accidently delete an
+ `delete-active-region' so that we don't accidentally delete an
active region when exporting a subtree/region.
* org-clock.el (org-program-exists): Remove.
@@ -10419,7 +10419,7 @@
space character when auto-filling.
* org.el (org-mode): Call external initalizers. Now both filling
- code and comments code have their own independant part in org.el.
+ code and comments code have their own independent part in org.el.
(org-setup-filling): Rename from `org-set-autofill-regexps'.
(org-setup-comments-handling): New function.
@@ -10652,7 +10652,7 @@
(org-list-struct-apply-struct, org-insert-item): Remove rule
check.
- * org-footnote.el (org-footnote-normalize): Fix positionning in
+ * org-footnote.el (org-footnote-normalize): Fix positioning in
HTML export without a footnote section.
* org-list.el (org-list-struct-indent):
@@ -11318,7 +11318,7 @@
2012-04-01 Shaun Johnson <shaun@slugfest.demon.co.uk> (tiny change)
* org-exp-blocks.el (org-ditaa-jar-path): Better heuristic to find
- the libary name.
+ the library name.
2012-04-01 Suvayu Ali <fatkasuvayu+linux@gmail.com>
@@ -11917,7 +11917,7 @@
2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
* org-footnote.el (org-footnote-at-definition-p): Make sure to
- move point at the beginning of the separator before skiping white
+ move point at the beginning of the separator before skipping white
spaces. Refactor code.
2012-04-01 Eric Schulte <eric.schulte@gmx.com>
@@ -13692,7 +13692,7 @@
2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
* org-publish.el (org-publish-cache-file-needs-publishing):
- Fix regexp to not inlcude newlines.
+ Fix regexp to not include newlines.
2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
@@ -14560,7 +14560,7 @@
2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
* org-footnote.el (org-footnote-normalize): Effectively remove
- any footnote tag in non Org buffers, as detailled in the
+ any footnote tag in non Org buffers, as detailed in the
docstring of `org-footnote-tag-for-non-org-mode-files'.
2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -15622,7 +15622,7 @@
2011-07-28 David Maus <dmaus@ictsoc.de>
* ob-haskell.el (org-babel-haskell-export-to-lhs):
- Call `kill-buffer' with argument indiciating to kill current
+ Call `kill-buffer' with argument indicating to kill current
buffer. Emacs 22 compatibility.
2011-07-28 David Maus <dmaus@ictsoc.de>
@@ -18049,7 +18049,7 @@
* org-table.el (org-table-fedit-finish): Read more general LHS of
formulas.
- (org-table-formula-handle-@L): New function to hanle @L references.
+ (org-table-formula-handle-@L): New function to handle @L references.
(org-table-current-ncol): New variable.
(org-table-line-to-dline): New function.
(org-table-get-stored-formulas): Accept range formulas as matches.
@@ -18058,7 +18058,7 @@
only the region marked by the range, not the content.
(org-table-recalculate): Call `org-table-expand-lhs-ranges' to expand
range targets. Also check for duplicate access to fields.
- (org-table-expand-lhs-ranges): New funktion.
+ (org-table-expand-lhs-ranges): New function.
(org-table-get-remote-range): Bind `org-table-current-ncol' to protect
the caller's value.
(org-table-edit-formulas): Support highlighting of range targets.
@@ -19339,8 +19339,8 @@
* org-crypt.el (org-encrypt-string): New function.
(org-encrypt-entry): Use org-encrypt-string to encrypt, so we use
- cached crypted values.
- (org-decrypt-entry): Store crypted text in decrypted text.
+ cached encrypted values.
+ (org-decrypt-entry): Store encrypted text in decrypted text.
2011-07-28 Dan Davison <dandavison7@gmail.com>
@@ -20331,7 +20331,7 @@
2010-12-11 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-quarter-to-date): Define variables.
- (org-clock-special-range): Defin variables. Use org-floor*.
+ (org-clock-special-range): Define variables. Use org-floor*.
(org-clocktable-write-default): Define tcol.
* org-compat.el (org-floor*): New function.
@@ -22854,7 +22854,7 @@
2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com>
* org-list.el (org-cycle-item-indentation): Do return t if and
- only if cycling is possible and succeded.
+ only if cycling is possible and succeeded.
2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -28181,7 +28181,7 @@
* org-src.el (org-src-lang-modes): New variable.
(org-edit-src-code): Translate language.
- * org-exp.el (org-export-format-source-code-or-example): Deal wit
+ * org-exp.el (org-export-format-source-code-or-example): Deal with
the new structure of the `org-export-latex-listings-langs'
variable.
@@ -28529,7 +28529,7 @@
* org.el (org-adapt-indentation): Slightly improve the docstring.
(org-occur): Sends an error when the user inputs an empty string.
- (org-priority): Bugfix: the tag alignement should happen within
+ (org-priority): Bugfix: the tag alignment should happen within
save-excursion.
2009-08-06 Bastien Guerry <bzg@gnu.org>
@@ -28830,7 +28830,7 @@
* org-agenda.el (org-agenda-mode): Reset list of marks.
(org-agenda-mode-map): Define new keys for refile and bulk action.
- (org-agenda-menu): Add menu itesm for refile and bulk action.
+ (org-agenda-menu): Add menu items for refile and bulk action.
(org-agenda-refile): New function.
(org-agenda-set-tags): Optional arguments TAG and ONOFF.
(org-agenda-marked-entries): New variable.
@@ -29490,7 +29490,7 @@
New functions.
(org-protocol-check-filename-for-protocol): Call `server-edit'.
- * org.el (org-default-properties): New default properteis for
+ * org.el (org-default-properties): New default properties for
completion.
* org-exp.el (org-export-add-subtree-options): Add new properties
@@ -29842,7 +29842,7 @@
* org-faces.el (org-checkbox): New face.
* org-exp.el (org-export-html-preprocess): Only create LaTeX
- fragement images if there is an export file.
+ fragment images if there is an export file.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
@@ -30465,7 +30465,7 @@
workings of `org-toggle-heading'.
(org-toggle-item): Rename from `org-toggle-region-items'.
No longer needs a region defined, but will use it if there is one.
- (org-ctrl-c-minus): Simplify, relying more on the inernal
+ (org-ctrl-c-minus): Simplify, relying more on the internal
workings of `org-toggle-item'.
* org-export-latex.el (org-export-latex-preprocess): Fix bug in
@@ -30674,7 +30674,7 @@
converter.
* org-exp.el (org-export-preprocess-string): Remove clock lines
- and timestamps already in the preprocesor.
+ and timestamps already in the preprocessor.
(org-export-remove-timestamps, org-export-remove-clock-lines):
New functions.
(org-export-as-ascii, org-export-as-html): Add the timestamps
@@ -31158,14 +31158,14 @@
2008-11-24 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-get-closed): Re-apply changes
- accidentially overwritten by last commit to Emacs.
+ accidentally overwritten by last commit to Emacs.
* org.el (org-outline-path-complete-in-steps): New option.
(org-refile-get-location):
Honor `org-outline-path-complete-in-steps'.
(org-agenda-change-all-lines, org-tags-sparse-tree)
(org-time-string-to-absolute, org-small-year-to-year)
- (org-link-escape): Re-apply changes accidentially overwritten
+ (org-link-escape): Re-apply changes accidentally overwritten
by last commit to Emacs.
2008-11-23 Carsten Dominik <carsten.dominik@gmail.com>
diff --git a/lisp/org/ob-coq.el b/lisp/org/ob-coq.el
index 56a57cdf649..d04a40dd3b3 100644
--- a/lisp/org/ob-coq.el
+++ b/lisp/org/ob-coq.el
@@ -27,7 +27,7 @@
;; session evaluation is supported. Requires both coq.el and
;; coq-inferior.el, both of which are distributed with Coq.
;;
-;; http://coq.inria.fr/
+;; https://coq.inria.fr/
;;; Code:
(require 'ob)
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index 7654c7ebe41..fe9af1ce602 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -2437,7 +2437,7 @@ INFO may provide the values of these header arguments (in the
(when location
(save-excursion
(goto-char location)
- (when (looking-at (concat org-babel-result-regexp ".*$"))
+ (when (looking-at org-babel-result-regexp)
(delete-region
(if keep-keyword (line-beginning-position 2)
(save-excursion
@@ -3053,9 +3053,8 @@ of `org-babel-temporary-directory'."
(if (eq t (car (file-attributes file)))
(delete-directory file)
(delete-file file)))
- ;; We do not want to delete "." and "..".
(directory-files org-babel-temporary-directory 'full
- (rx (or (not ".") "..."))))
+ directory-files-no-dot-files-regexp))
(delete-directory org-babel-temporary-directory))
(error
(message "Failed to remove temporary Org-babel directory %s"
diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el
index 154465f28e1..149058f05f4 100644
--- a/lisp/org/ob-fortran.el
+++ b/lisp/org/ob-fortran.el
@@ -106,7 +106,7 @@ its header arguments."
(defun org-babel-fortran-ensure-main-wrap (body params)
"Wrap body in a \"program ... end program\" block if none exists."
- (if (string-match "^[ \t]*program[ \t]*.*" (capitalize body))
+ (if (string-match "^[ \t]*program\\>" (capitalize body))
(let ((vars (org-babel--get-vars params)))
(when vars (error "Cannot use :vars if `program' statement is present"))
body)
diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el
index 8f66d102074..655e253d925 100644
--- a/lisp/org/ob-js.el
+++ b/lisp/org/ob-js.el
@@ -30,11 +30,11 @@
;;; Requirements:
-;; - a non-browser javascript engine such as node.js http://nodejs.org/
-;; or mozrepl http://wiki.github.com/bard/mozrepl/
+;; - a non-browser javascript engine such as node.js https://nodejs.org/
+;; or mozrepl https://wiki.github.com/bard/mozrepl/
;;
;; - for session based evaluation mozrepl and moz.el are required see
-;; http://wiki.github.com/bard/mozrepl/emacs-integration for
+;; https://wiki.github.com/bard/mozrepl/emacs-integration for
;; configuration instructions
;;; Code:
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index 5bf9e2beee4..49886e292e5 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -26,7 +26,7 @@
;; Org-Babel support for evaluating plantuml script.
;;
;; Inspired by Ian Yang's org-export-blocks-format-plantuml
-;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el
+;; https://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el
;;; Requirements:
diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el
index 90956271cf5..aa28bf18995 100644
--- a/lisp/org/ob-ruby.el
+++ b/lisp/org/ob-ruby.el
@@ -30,10 +30,10 @@
;; - ruby and irb executables :: http://www.ruby-lang.org/
;;
;; - ruby-mode :: Can be installed through ELPA, or from
-;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el
+;; https://github.com/eschulte/rinari/raw/master/util/ruby-mode.el
;;
;; - inf-ruby mode :: Can be installed through ELPA, or from
-;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el
+;; https://github.com/eschulte/rinari/raw/master/util/inf-ruby.el
;;; Code:
(require 'ob)
@@ -51,7 +51,8 @@
(defvar org-babel-default-header-args:ruby '())
(defvar org-babel-ruby-command "ruby"
- "Name of command to use for executing ruby code.")
+ "Name of command to use for executing ruby code.
+It's possible to override it by using a header argument `:ruby'")
(defcustom org-babel-ruby-hline-to "nil"
"Replace hlines in incoming tables with this when translating to ruby."
@@ -71,7 +72,7 @@
"Execute a block of Ruby code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-ruby-initiate-session
- (cdr (assq :session params))))
+ (cdr (assq :session params)) params))
(result-params (cdr (assq :result-params params)))
(result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
@@ -147,14 +148,15 @@ Emacs-lisp table, otherwise return the results as a string."
res)
res)))
-(defun org-babel-ruby-initiate-session (&optional session _params)
+(defun org-babel-ruby-initiate-session (&optional session params)
"Initiate a ruby session.
If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session."
(unless (string= session "none")
(require 'inf-ruby)
- (let* ((cmd (cdr (assoc inf-ruby-default-implementation
- inf-ruby-implementations)))
+ (let* ((cmd (cdr (or (assq :ruby params)
+ (assoc inf-ruby-default-implementation
+ inf-ruby-implementations))))
(buffer (get-buffer (format "*%s*" session)))
(session-buffer (or buffer (save-window-excursion
(run-ruby cmd session)
diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el
index 60c081dcb38..c101574696c 100644
--- a/lisp/org/ob-sass.el
+++ b/lisp/org/ob-sass.el
@@ -35,7 +35,7 @@
;;; Requirements:
-;; - sass-mode :: http://github.com/nex3/haml/blob/master/extra/sass-mode.el
+;; - sass-mode :: https://github.com/nex3/haml/blob/master/extra/sass-mode.el
;;; Code:
(require 'ob)
diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el
index ad00ee070d4..837c18f8407 100644
--- a/lisp/org/ob-screen.el
+++ b/lisp/org/ob-screen.el
@@ -126,7 +126,7 @@ The terminal should shortly flicker."
;; XXX: need to find a better way to do the following
(while (not (file-readable-p tmpfile))
;; do something, otherwise this will be optimized away
- (format "org-babel-screen: File not readable yet."))
+ (sit-for 0.1))
(setq tmp-string (with-temp-buffer
(insert-file-contents-literally tmpfile)
(buffer-substring (point-min) (point-max))))
diff --git a/lisp/org/ob-stan.el b/lisp/org/ob-stan.el
index c563a6c3e55..678047c8008 100644
--- a/lisp/org/ob-stan.el
+++ b/lisp/org/ob-stan.el
@@ -41,7 +41,7 @@
;; For more information and usage examples, visit
;; https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html
;;
-;; [1] http://mc-stan.org/
+;; [1] https://mc-stan.org/
;;; Code:
(require 'ob)
diff --git a/lisp/org/ob-vala.el b/lisp/org/ob-vala.el
index e9c214f7dfc..b1c22756226 100644
--- a/lisp/org/ob-vala.el
+++ b/lisp/org/ob-vala.el
@@ -26,7 +26,7 @@
;;; Commentary:
;; ob-vala.el provides Babel support for the Vala language
-;; (see http://live.gnome.org/Vala for details)
+;; (see https://live.gnome.org/Vala for details)
;;; Requirements:
diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el
index 99472315f67..71d55cd7c8d 100644
--- a/lisp/org/ol-gnus.el
+++ b/lisp/org/ol-gnus.el
@@ -34,7 +34,7 @@
(require 'gnus-sum)
(require 'gnus-util)
(require 'nnheader)
-(require 'nnir)
+(require 'nnselect)
(require 'ol)
@@ -140,9 +140,9 @@ If `org-store-link' was called with a prefix arg the meaning of
(`(nnvirtual . ,_)
(save-excursion
(car (nnvirtual-map-article (gnus-summary-article-number)))))
- (`(nnir . ,_)
+ (`(nnselect . ,_)
(save-excursion
- (nnir-article-group (gnus-summary-article-number))))
+ (nnselect-article-group (gnus-summary-article-number))))
(_ gnus-newsgroup-name)))
(header (if (eq major-mode 'gnus-article-mode)
;; When in an article, first move to summary
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index baed23bc9a4..c9e4da598ff 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -845,8 +845,8 @@ E.g. \"%C3%B6\" becomes the german o-Umlaut."
(insert link)
(insert (make-string (- (skip-chars-backward "\\\\"))
?\\))
- (while (search-backward "\]" nil t)
- (when (looking-at-p "\\]\\(?:[][]\\|\\'\\)")
+ (while (search-backward "]" nil t)
+ (when (looking-at-p "]\\(?:[][]\\|\\'\\)")
(insert (make-string (1+ (- (skip-chars-backward "\\\\")))
?\\))))
(buffer-string)))
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 4f89ea54500..689d134627e 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -1883,7 +1883,7 @@ Nil means don't hide any tags."
:group 'org-agenda-line-format
:type '(choice
(const :tag "Hide none" nil)
- (string :tag "Regexp ")))
+ (regexp :tag "Regexp ")))
(defvaralias 'org-agenda-remove-tags-when-in-prefix
'org-agenda-remove-tags)
@@ -1980,7 +1980,7 @@ category, you can use:
(\"Emacs\" \\='(space . (:width (16))))"
:group 'org-agenda-line-format
:version "24.1"
- :type '(alist :key-type (string :tag "Regexp matching category")
+ :type '(alist :key-type (regexp :tag "Regexp matching category")
:value-type (choice (list :tag "Icon"
(string :tag "File or data")
(symbol :tag "Type")
@@ -2995,7 +2995,8 @@ Agenda views are separated by `org-agenda-block-separator'."
(erase-buffer)
(insert (eval-when-compile
(let ((header
- "Press key for an agenda command:
+ (copy-sequence
+ "Press key for an agenda command:
-------------------------------- < Buffer, subtree/region restriction
a Agenda for current week or day > Remove restriction
t List of all TODO entries e Export agenda views
@@ -3004,7 +3005,7 @@ s Search for keywords M Like m, but only TODO entries
/ Multi-occur S Like s, but only TODO entries
? Find :FLAGGED: entries C Configure custom agenda commands
* Toggle sticky agenda views # List stuck projects (!=configure)
-")
+"))
(start 0))
(while (string-match
"\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)"
@@ -8981,7 +8982,6 @@ fold drawers."
(narrow-to-region (org-entry-beginning-position)
(org-entry-end-position))
(org-show-all '(drawers))))
- (when arg )
(setq org-agenda-show-window (selected-window)))
(select-window win)))
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index 003cbef1fdf..ace51270175 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -1021,7 +1021,7 @@ Store them in the capture property list."
(apply #'encode-time 0 0
org-extend-today-until
(cl-cdddr (decode-time prompt-time))))
- ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)"
+ ((string-match "\\([^ ]+\\)-[^ ]+[ ]+\\(.*\\)"
org-read-date-final-answer)
;; Replace any time range by its start.
(apply #'encode-time
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index 4b5f9a19e6d..ef64f58f81b 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -4144,7 +4144,9 @@ If STRING is the empty string or nil, return nil."
(dolist (v local-variables)
(ignore-errors
(if (symbolp v) (makunbound v)
- (set (make-local-variable (car v)) (cdr v)))))
+ ;; Don't set file name to avoid mishandling hooks (bug#44524)
+ (unless (memq (car v) '(buffer-file-name buffer-file-truename))
+ (set (make-local-variable (car v)) (cdr v))))))
;; Transferring local variables may put the temporary buffer
;; into a read-only state. Make sure we can insert STRING.
(let ((inhibit-read-only t)) (insert string))
@@ -4892,7 +4894,7 @@ with `org-element--cache-compare'. This cache is used in
A request is a vector with the following pattern:
- \[NEXT BEG END OFFSET PARENT PHASE]
+ [NEXT BEG END OFFSET PARENT PHASE]
Processing a synchronization request consists of three phases:
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 0ff0e401d27..55a534d0dcd 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -278,7 +278,7 @@ This should be a single regexp string."
:group 'org-protocol
:version "24.4"
:package-version '(Org . "8.0")
- :type 'string)
+ :type 'regexp)
;;; Helper functions:
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 49765472558..5c37cb1af52 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -198,7 +198,7 @@ Other options offered by the customize interface are more restrictive."
"^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][[:xdigit:].]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$")
(const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark"
"^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][[:xdigit:].]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$")
- (string :tag "Regexp:")))
+ (regexp :tag "Regexp:")))
(defcustom org-table-number-fraction 0.5
"Fraction of numbers in a column required to make the column align right.
@@ -2005,7 +2005,7 @@ the table and kill the editing buffer."
text)
(goto-char (point-min))
(while (re-search-forward "^#.*\n?" nil t) (replace-match ""))
- (while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t)
+ (while (re-search-forward "[ \t]*\n[ \t\n]*" nil t)
(replace-match " "))
(setq text (org-trim (buffer-string)))
(set-window-configuration cw)
@@ -3099,7 +3099,7 @@ function assumes the table is already analyzed (i.e., using
(let ((lhs (car e))
(rhs (cdr e)))
(cond
- ((string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs)
+ ((string-match-p "\\`@[-+0-9]+\\$-?[0-9]+\\'" lhs)
;; This just refers to one fixed field.
(push e res))
((string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs)
@@ -6122,7 +6122,7 @@ which will prompt for the width."
;; Here are two examples of different styles.
;; Unicode block characters are used to give a smooth effect.
-;; See http://en.wikipedia.org/wiki/Block_Elements
+;; See https://en.wikipedia.org/wiki/Block_Elements
;; Use one of those drawing functions
;; - orgtbl-ascii-draw (the default ascii)
;; - orgtbl-uc-draw-grid (unicode with a grid effect)
@@ -6136,7 +6136,7 @@ which will prompt for the width."
It is a variant of orgtbl-ascii-draw with Unicode block
characters, for a smooth display. Bars appear as grids (to the
extent the font allows)."
- ;; http://en.wikipedia.org/wiki/Block_Elements
+ ;; https://en.wikipedia.org/wiki/Block_Elements
;; best viewed with the "DejaVu Sans Mono" font.
(orgtbl-ascii-draw value min max width
" \u258F\u258E\u258D\u258C\u258B\u258A\u2589"))
diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el
index 9ae2700549c..fe3b5f8da10 100644
--- a/lisp/org/org-tempo.el
+++ b/lisp/org/org-tempo.el
@@ -4,7 +4,7 @@
;;
;; Author: Rasmus Pank Roulund <emacs at pank dot eu>
;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
+;; Homepage: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
diff --git a/lisp/org/org.el b/lisp/org/org.el
index a7502d188e2..1ab8ab68880 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -223,7 +223,8 @@ byte-compiled before it is loaded."
(org-babel-tangle-file file tangled-file "emacs-lisp"))
(if compile
(progn
- (byte-compile-file tangled-file 'load)
+ (byte-compile-file tangled-file)
+ (load tangled-file)
(message "Compiled and loaded %s" tangled-file))
(load-file tangled-file)
(message "Loaded %s" tangled-file))))
@@ -460,7 +461,7 @@ Matched keyword is in group 1.")
org-clock-string)
t)
"\\)?"
- " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]"
+ " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*[]>]"
"\\|"
"<%%([^\r\n>]*>\\)")
"Matches a timestamp, possibly preceded by a keyword.")
@@ -564,14 +565,14 @@ Effort estimates given in this property need to have the format H:MM.")
;;;; Timestamp
-(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
+(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*\\)>"
"Regular expression for fast time stamp matching.")
(defconst org-ts-regexp-inactive
- "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]"
+ "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*\\)\\]"
"Regular expression for fast inactive time stamp matching.")
-(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]"
+(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*\\)[]>]"
"Regular expression for fast time stamp matching.")
(defconst org-ts-regexp0
@@ -11410,8 +11411,8 @@ D Show deadlines and scheduled items between a date range."
(setq type (or type org-sparse-tree-default-date-type))
(setq org-ts-type type)
(message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty
- \[d]eadlines [b]efore-date [a]fter-date [D]ates range
- \[c]ycle through date types: %s"
+ [d]eadlines [b]efore-date [a]fter-date [D]ates range
+ [c]ycle through date types: %s"
(cl-case type
(all "all timestamps")
(scheduled "only scheduled")
diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el
index edb3150796f..2f61abad9cc 100644
--- a/lisp/org/ox-latex.el
+++ b/lisp/org/ox-latex.el
@@ -1239,7 +1239,7 @@ calling `org-latex-compile'."
:package-version '(Org . "8.3")
:type '(repeat
(cons
- (string :tag "Regexp")
+ (regexp :tag "Regexp")
(string :tag "Message"))))
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
index 51cb42a49a5..229b524f843 100644
--- a/lisp/org/ox-odt.el
+++ b/lisp/org/ox-odt.el
@@ -940,7 +940,7 @@ See `org-odt--build-date-styles' for implementation details."
(has-time-p (or (not timestamp)
(org-timestamp-has-time-p timestamp)))
(iso-date (let ((format (if has-time-p "%Y-%m-%dT%H:%M:%S"
- "%Y-%m-%dT%H:%M:%S")))
+ "%Y-%m-%d")))
(funcall format-timestamp timestamp format end))))
(if iso-date-p iso-date
(let* ((style (if has-time-p "OrgDate2" "OrgDate1"))
@@ -2199,10 +2199,10 @@ SHORT-CAPTION are strings."
(defun org-odt--image-size
(file info &optional user-width user-height scale dpi embed-as)
(let* ((--pixels-to-cms
- (function (lambda (pixels dpi)
- (let ((cms-per-inch 2.54)
- (inches (/ pixels dpi)))
- (* cms-per-inch inches)))))
+ (lambda (pixels dpi)
+ (let ((cms-per-inch 2.54)
+ (inches (/ pixels dpi)))
+ (* cms-per-inch inches))))
(--size-in-cms
(function
(lambda (size-in-pixels dpi)
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 797efb90b79..2f8fd0c645b 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -5459,7 +5459,7 @@ transcoding it."
(apostrophe :utf-8 "’" :html "&rsquo;"))
("da"
;; one may use: »...«, "...", ›...‹, or '...'.
- ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
+ ;; https://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
;; LaTeX quotes require Babel!
(primary-opening
:utf-8 "»" :html "&raquo;" :latex ">>" :texinfo "@guillemetright{}")
@@ -5553,7 +5553,7 @@ transcoding it."
(secondary-closing :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
(apostrophe :utf-8 "’" :html "&rsquo;"))
("ru"
- ;; http://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5
+ ;; https://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5
;; http://www.artlebedev.ru/kovodstvo/sections/104/
(primary-opening :utf-8 "«" :html "&laquo;" :latex "{}<<"
:texinfo "@guillemetleft{}")
diff --git a/lisp/outline.el b/lisp/outline.el
index 28ea8a86e6f..47e6528859f 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -1,4 +1,4 @@
-;;; outline.el --- outline mode commands for Emacs
+;;; outline.el --- outline mode commands for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1986, 1993-1995, 1997, 2000-2020 Free Software
;; Foundation, Inc.
@@ -166,7 +166,7 @@ in the file it applies to.")
;; Remove extra separator
(cdr
;; Flatten the major mode's menus into a single menu.
- (apply 'append
+ (apply #'append
(mapcar (lambda (x)
(if (consp x)
;; Add a separator between each
@@ -179,6 +179,12 @@ in the file it applies to.")
(let ((map (make-sparse-keymap)))
(define-key map "\C-c" outline-mode-prefix-map)
(define-key map [menu-bar] outline-mode-menu-bar-map)
+ ;; Only takes effect if point is on a heading.
+ (define-key map (kbd "TAB")
+ `(menu-item "" outline-cycle
+ :filter ,(lambda (cmd)
+ (when (outline-on-heading-p) cmd))))
+ (define-key map (kbd "<backtab>") #'outline-cycle-buffer)
map))
(defvar outline-font-lock-keywords
@@ -190,47 +196,45 @@ in the file it applies to.")
(defface outline-1
'((t :inherit font-lock-function-name-face))
- "Level 1."
- :group 'outlines)
+ "Level 1.")
(defface outline-2
'((t :inherit font-lock-variable-name-face))
- "Level 2."
- :group 'outlines)
+ "Level 2.")
(defface outline-3
'((t :inherit font-lock-keyword-face))
- "Level 3."
- :group 'outlines)
+ "Level 3.")
(defface outline-4
'((t :inherit font-lock-comment-face))
- "Level 4."
- :group 'outlines)
+ "Level 4.")
(defface outline-5
'((t :inherit font-lock-type-face))
- "Level 5."
- :group 'outlines)
+ "Level 5.")
(defface outline-6
'((t :inherit font-lock-constant-face))
- "Level 6."
- :group 'outlines)
+ "Level 6.")
(defface outline-7
'((t :inherit font-lock-builtin-face))
- "Level 7."
- :group 'outlines)
+ "Level 7.")
(defface outline-8
'((t :inherit font-lock-string-face))
- "Level 8."
- :group 'outlines)
+ "Level 8.")
(defvar outline-font-lock-faces
[outline-1 outline-2 outline-3 outline-4
outline-5 outline-6 outline-7 outline-8])
+
+(defvar outline-level #'outline-level
+ "Function of no args to compute a header's nesting level in an outline.
+It can assume point is at the beginning of a header line and that the match
+data reflects the `outline-regexp'.")
+;;;###autoload(put 'outline-level 'risky-local-variable t)
(defun outline-font-lock-face ()
"Return one of `outline-font-lock-faces' for current level."
@@ -273,28 +277,33 @@ beginning of the line. The longer the match, the deeper the level.
Turning on outline mode calls the value of `text-mode-hook' and then of
`outline-mode-hook', if they are non-nil."
- (make-local-variable 'line-move-ignore-invisible)
- (setq line-move-ignore-invisible t)
+ (setq-local line-move-ignore-invisible t)
;; Cause use of ellipses for invisible text.
(add-to-invisibility-spec '(outline . t))
- (set (make-local-variable 'paragraph-start)
- (concat paragraph-start "\\|\\(?:" outline-regexp "\\)"))
+ (setq-local paragraph-start
+ (concat paragraph-start "\\|\\(?:" outline-regexp "\\)"))
;; Inhibit auto-filling of header lines.
- (set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp)
- (set (make-local-variable 'paragraph-separate)
- (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)"))
- (set (make-local-variable 'font-lock-defaults)
- '(outline-font-lock-keywords t nil nil backward-paragraph))
- (setq imenu-generic-expression
- (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)))
- (add-hook 'change-major-mode-hook 'outline-show-all nil t))
+ (setq-local auto-fill-inhibit-regexp outline-regexp)
+ (setq-local paragraph-separate
+ (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)"))
+ (setq-local font-lock-defaults
+ '(outline-font-lock-keywords t nil nil backward-paragraph))
+ (setq-local imenu-generic-expression
+ (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)))
+ (add-hook 'change-major-mode-hook #'outline-show-all nil t))
+
+(defvar outline-minor-mode-map)
(defcustom outline-minor-mode-prefix "\C-c@"
"Prefix key to use for Outline commands in Outline minor mode.
The value of this variable is checked as part of loading Outline mode.
After that, changing the prefix key requires manipulating keymaps."
- :type 'string
- :group 'outlines)
+ :type 'key-sequence
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (define-key outline-minor-mode-map outline-minor-mode-prefix nil)
+ (define-key outline-minor-mode-map val outline-mode-prefix-map)
+ (set-default sym val)))
;;;###autoload
(define-minor-mode outline-minor-mode
@@ -303,7 +312,6 @@ After that, changing the prefix key requires manipulating keymaps."
See the command `outline-mode' for more information on this mode."
nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
(cons outline-minor-mode-prefix outline-mode-prefix-map))
- :group 'outlines
(if outline-minor-mode
(progn
;; Turn off this mode if we change major modes.
@@ -318,14 +326,8 @@ See the command `outline-mode' for more information on this mode."
(remove-from-invisibility-spec '(outline . t))
;; When turning off outline mode, get rid of any outline hiding.
(outline-show-all)))
-
-(defvar outline-level 'outline-level
- "Function of no args to compute a header's nesting level in an outline.
-It can assume point is at the beginning of a header line and that the match
-data reflects the `outline-regexp'.")
-;;;###autoload(put 'outline-level 'risky-local-variable t)
-(defvar outline-heading-alist ()
+(defvar-local outline-heading-alist ()
"Alist associating a heading for every possible level.
Each entry is of the form (HEADING . LEVEL).
This alist is used two ways: to find the heading corresponding to
@@ -344,7 +346,6 @@ within each set. For example in texinfo mode:
Instead of sorting the entries in each set, you can also separate the
sets with nil.")
-(make-variable-buffer-local 'outline-heading-alist)
;; This used to count columns rather than characters, but that made ^L
;; appear to be at level 2 instead of 1. Columns would be better for
@@ -389,6 +390,8 @@ at the end of the buffer."
If POS is nil, use `point' instead."
(eq (get-char-property (or pos (point)) 'invisible) 'outline))
+(define-error 'outline-before-first-heading "Before first heading")
+
(defun outline-back-to-heading (&optional invisible-ok)
"Move to previous heading line, or beg of this line if it's a heading.
Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
@@ -399,7 +402,7 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
(while (not found)
(or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
nil t)
- (error "Before first heading"))
+ (signal 'outline-before-first-heading nil))
(setq found (and (or invisible-ok (not (outline-invisible-p)))
(point)))))
(goto-char found)
@@ -464,9 +467,9 @@ nil for WHICH, or do not pass any argument)."
(if current-prefix-arg nil 'subtree))))
(cond
((eq which 'region)
- (outline-map-region 'outline-promote (region-beginning) (region-end)))
+ (outline-map-region #'outline-promote (region-beginning) (region-end)))
(which
- (outline-map-region 'outline-promote
+ (outline-map-region #'outline-promote
(point)
(save-excursion (outline-get-next-sibling) (point))))
(t
@@ -503,9 +506,9 @@ nil for WHICH, or do not pass any argument)."
(if current-prefix-arg nil 'subtree))))
(cond
((eq which 'region)
- (outline-map-region 'outline-demote (region-beginning) (region-end)))
+ (outline-map-region #'outline-demote (region-beginning) (region-end)))
(which
- (outline-map-region 'outline-demote
+ (outline-map-region #'outline-demote
(point)
(save-excursion (outline-get-next-sibling) (point))))
(t
@@ -685,12 +688,12 @@ This puts point at the start of the current subtree, and mark at the end."
(goto-char beg)))
-(defvar outline-isearch-open-invisible-function nil
+(defvar outline-isearch-open-invisible-function
+ #'outline-isearch-open-invisible
"Function called if `isearch' finishes in an invisible overlay.
-The function is called with the overlay as its only argument.
-If nil, `outline-show-entry' is called to reveal the invisible text.")
+The function is called with the overlay as its only argument.")
-(put 'outline 'reveal-toggle-invisible 'outline-reveal-toggle-invisible)
+(put 'outline 'reveal-toggle-invisible #'outline-reveal-toggle-invisible)
(defun outline-flag-region (from to flag)
"Hide or show lines from FROM to TO, according to FLAG.
If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
@@ -704,7 +707,7 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
(overlay-put o 'invisible 'outline)
(overlay-put o 'isearch-open-invisible
(or outline-isearch-open-invisible-function
- 'outline-isearch-open-invisible))))
+ #'outline-isearch-open-invisible))))
;; Seems only used by lazy-lock. I.e. obsolete.
(run-hooks 'outline-view-change-hook))
@@ -764,8 +767,7 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
(outline-end-of-heading)
(outline-flag-region (point) (progn (outline-next-preface) (point)) t)))
-(define-obsolete-function-alias
- 'hide-entry 'outline-hide-entry "25.1")
+(define-obsolete-function-alias 'hide-entry #'outline-hide-entry "25.1")
(defun outline-show-entry ()
"Show the body directly following this heading.
@@ -781,8 +783,7 @@ Show the heading too, if it is currently invisible."
(point)))
nil)))
-(define-obsolete-function-alias
- 'show-entry 'outline-show-entry "25.1")
+(define-obsolete-function-alias 'show-entry #'outline-show-entry "25.1")
(defun outline-hide-body ()
"Hide all body lines in buffer, leaving all headings visible.
@@ -790,8 +791,7 @@ Note that this does not hide the lines preceding the first heading line."
(interactive)
(outline-hide-region-body (point-min) (point-max)))
-(define-obsolete-function-alias
- 'hide-body 'outline-hide-body "25.1")
+(define-obsolete-function-alias 'hide-body #'outline-hide-body "25.1")
(defun outline-hide-region-body (start end)
"Hide all body lines between START and END, but not headings."
@@ -815,23 +815,21 @@ Note that this does not hide the lines preceding the first heading line."
(run-hooks 'outline-view-change-hook))
(define-obsolete-function-alias
- 'hide-region-body 'outline-hide-region-body "25.1")
+ 'hide-region-body #'outline-hide-region-body "25.1")
(defun outline-show-all ()
"Show all of the text in the buffer."
(interactive)
(outline-flag-region (point-min) (point-max) nil))
-(define-obsolete-function-alias
- 'show-all 'outline-show-all "25.1")
+(define-obsolete-function-alias 'show-all #'outline-show-all "25.1")
(defun outline-hide-subtree ()
"Hide everything after this heading at deeper levels."
(interactive)
(outline-flag-subtree t))
-(define-obsolete-function-alias
- 'hide-subtree 'outline-hide-subtree "25.1")
+(define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1")
(defun outline-hide-leaves ()
"Hide the body after this heading and at deeper levels."
@@ -844,16 +842,14 @@ Note that this does not hide the lines preceding the first heading line."
(point)
(progn (outline-end-of-subtree) (point)))))
-(define-obsolete-function-alias
- 'hide-leaves 'outline-hide-leaves "25.1")
+(define-obsolete-function-alias 'hide-leaves #'outline-hide-leaves "25.1")
(defun outline-show-subtree ()
"Show everything after this heading at deeper levels."
(interactive)
(outline-flag-subtree nil))
-(define-obsolete-function-alias
- 'show-subtree 'outline-show-subtree "25.1")
+(define-obsolete-function-alias 'show-subtree #'outline-show-subtree "25.1")
(defun outline-show-heading ()
"Show the current heading and move to its end."
@@ -908,8 +904,7 @@ of the current heading, or to 1 if the current line is not a heading."
(outline-flag-region (1- (point)) (point) nil))))
(run-hooks 'outline-view-change-hook))
-(define-obsolete-function-alias
- 'hide-sublevels 'outline-hide-sublevels "25.1")
+(define-obsolete-function-alias 'hide-sublevels #'outline-hide-sublevels "25.1")
(defun outline-hide-other ()
"Hide everything except current body and parent and top-level headings.
@@ -927,8 +922,7 @@ This also unhides the top heading-less body, if any."
nil))))
(run-hooks 'outline-view-change-hook))
-(define-obsolete-function-alias
- 'hide-other 'outline-hide-other "25.1")
+(define-obsolete-function-alias 'hide-other #'outline-hide-other "25.1")
(defun outline-toggle-children ()
"Show or hide the current subtree depending on its current state."
@@ -972,8 +966,7 @@ This also unhides the top heading-less body, if any."
(interactive)
(outline-show-children 1000))
-(define-obsolete-function-alias
- 'show-branches 'outline-show-branches "25.1")
+(define-obsolete-function-alias 'show-branches #'outline-show-branches "25.1")
(defun outline-show-children (&optional level)
"Show all direct subheadings of this heading.
@@ -1002,8 +995,7 @@ Default is enough to cause the following heading to appear."
(if (eobp) (point-max) (1+ (point)))))))
(run-hooks 'outline-view-change-hook))
-(define-obsolete-function-alias
- 'show-children 'outline-show-children "25.1")
+(define-obsolete-function-alias 'show-children #'outline-show-children "25.1")
@@ -1118,6 +1110,79 @@ convenient way to make a table of contents of the buffer."
(insert "\n\n"))))))
(kill-new (buffer-string)))))))
+(defun outline--cycle-state ()
+ "Return the cycle state of current heading.
+Return either 'hide-all, 'headings-only, or 'show-all."
+ (save-excursion
+ (let (start end ov-list heading-end)
+ (outline-back-to-heading)
+ (setq start (point))
+ (outline-end-of-heading)
+ (setq heading-end (point))
+ (outline-end-of-subtree)
+ (setq end (point))
+ (setq ov-list (cl-remove-if-not
+ (lambda (o) (eq (overlay-get o 'invisible) 'outline))
+ (overlays-in start end)))
+ (cond ((eq ov-list nil) 'show-all)
+ ;; (eq (length ov-list) 1) wouldn’t work: what if there is
+ ;; one folded subheading?
+ ((and (eq (overlay-end (car ov-list)) end)
+ (eq (overlay-start (car ov-list)) heading-end))
+ 'hide-all)
+ (t 'headings-only)))))
+
+(defun outline-has-subheading-p ()
+ "Return t if this heading has subheadings, nil otherwise."
+ (save-excursion
+ (outline-back-to-heading)
+ (< (save-excursion (outline-next-heading) (point))
+ (save-excursion (outline-end-of-subtree) (point)))))
+
+(defun outline-cycle ()
+ "Cycle between `hide all', `headings only' and `show all'.
+
+`Hide all' means hide all subheadings and their bodies.
+`Headings only' means show sub headings but not their bodies.
+`Show all' means show all subheadings and their bodies."
+ (interactive)
+ (condition-case nil
+ (pcase (outline--cycle-state)
+ ('hide-all
+ (if (outline-has-subheading-p)
+ (progn (outline-show-children)
+ (message "Only headings"))
+ (outline-show-subtree)
+ (message "Show all")))
+ ('headings-only
+ (outline-show-subtree)
+ (message "Show all"))
+ ('show-all
+ (outline-hide-subtree)
+ (message "Hide all")))
+ (outline-before-first-heading nil)))
+
+(defvar-local outline--cycle-buffer-state 'show-all
+ "Internal variable used for tracking buffer cycle state.")
+
+(defun outline-cycle-buffer ()
+ "Cycle the whole buffer like in `outline-cycle'."
+ (interactive)
+ (pcase outline--cycle-buffer-state
+ ('show-all
+ (outline-hide-sublevels 1)
+ (setq outline--cycle-buffer-state 'top-level)
+ (message "Top level headings"))
+ ('top-level
+ (outline-show-all)
+ (outline-hide-region-body (point-min) (point-max))
+ (setq outline--cycle-buffer-state 'all-heading)
+ (message "All headings"))
+ ('all-heading
+ (outline-show-all)
+ (setq outline--cycle-buffer-state 'show-all)
+ (message "Show all"))))
+
(provide 'outline)
(provide 'noutline)
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index 5e5f3240bc3..2443f374a84 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -31,7 +31,8 @@
;; ;; Minibuffer prompt for password.
;; => "foo"
;;
-;; (password-cache-add "test" "foo")
+;; (password-cache-add "test" (read-passwd "Password? "))
+;; ;; Minibuffer prompt from read-passwd, which returns "foo".
;; => nil
;; (password-read "Password? " "test")
@@ -93,22 +94,6 @@ The variable `password-cache' control whether the cache is used."
(or (password-read-from-cache key)
(read-passwd prompt)))
-(defun password-read-and-add (prompt &optional key)
- "Read password, for use with KEY, from user, or from cache if wanted.
-Then store the password in the cache. Uses `password-read' and
-`password-cache-add'. Custom variables `password-cache' and
-`password-cache-expiry' regulate cache behavior.
-
-Warning: the password is cached without checking that it is
-correct. It is better to check the password before caching. If
-you must use this function, take care to check passwords and
-remove incorrect ones from the cache."
- (declare (obsolete password-read "23.1"))
- (let ((password (password-read prompt key)))
- (when (and password key)
- (password-cache-add key password))
- password))
-
(defun password-cache-remove (key)
"Remove password indexed by KEY from password cache.
This is typically run by a timer setup from `password-cache-add',
diff --git a/lisp/pcmpl-cvs.el b/lisp/pcmpl-cvs.el
index 1b49b297e42..13f3093c218 100644
--- a/lisp/pcmpl-cvs.el
+++ b/lisp/pcmpl-cvs.el
@@ -1,4 +1,4 @@
-;;; pcmpl-cvs.el --- functions for dealing with cvs completions
+;;; pcmpl-cvs.el --- functions for dealing with cvs completions -*- lexical-binding: t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -29,7 +29,6 @@
(provide 'pcmpl-cvs)
(require 'pcomplete)
-(require 'executable)
(defgroup pcmpl-cvs nil
"Functions for dealing with CVS completions."
@@ -39,8 +38,7 @@
(defcustom pcmpl-cvs-binary (or (executable-find "cvs") "cvs")
"The full path of the `cvs' binary."
- :type 'file
- :group 'pcmpl-cvs)
+ :type 'file)
;; Functions:
@@ -139,7 +137,7 @@
(let ((entries (pcmpl-cvs-entries opers))
tags)
(with-temp-buffer
- (apply 'call-process pcmpl-cvs-binary nil t nil
+ (apply #'call-process pcmpl-cvs-binary nil t nil
"status" "-v" entries)
(goto-char (point-min))
(while (re-search-forward "Existing Tags:" nil t)
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index 098aa3d5fe1..fa84b31675e 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -67,12 +67,13 @@
nil
(function
(lambda (entry)
- (when (and (file-readable-p entry)
- (file-regular-p entry))
- (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'"
- entry)))
- (or (and unzip-p zipped)
- (and (not unzip-p) (not zipped)))))))))
+ (or (file-directory-p entry)
+ (when (and (file-readable-p entry)
+ (file-regular-p entry))
+ (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'"
+ entry)))
+ (or (and unzip-p zipped)
+ (and (not unzip-p) (not zipped))))))))))
;;;###autoload
(defun pcomplete/bzip2 ()
@@ -118,7 +119,7 @@
Return the new list."
(goto-char (point-min))
(while (re-search-forward
- "^\\s-*\\([^\n#%.$][^:=\n]*\\)\\s-*:[^=]" nil t)
+ "^\\([^\t\n#%.$][^:=\n]*\\)\\s-*:[^=]" nil t)
(setq targets (nconc (split-string (match-string-no-properties 1))
targets)))
targets)
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index 6e036434ef2..df9d24507a0 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -1,4 +1,4 @@
-;;; pcmpl-linux.el --- functions for dealing with GNU/Linux completions
+;;; pcmpl-linux.el --- functions for dealing with GNU/Linux completions -*- lexical-binding: t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -65,18 +65,22 @@
(pcomplete-opt "hVanfFrsvwt(pcmpl-linux-fs-types)o?L?U?")
(while (pcomplete-here (pcomplete-entries) nil 'identity)))
+(defconst pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/")
+
(defun pcmpl-linux-fs-types ()
"Return a list of available fs modules on GNU/Linux systems."
(let ((kernel-ver (pcomplete-process-result "uname" "-r")))
(directory-files
- (concat "/lib/modules/" kernel-ver "/kernel/fs/"))))
+ (format pcmpl-linux-fs-modules-path-format kernel-ver))))
+
+(defconst pcmpl-linux-mtab-file "/etc/mtab")
(defun pcmpl-linux-mounted-directories ()
"Return a list of mounted directory names."
(let (points)
- (when (file-readable-p "/etc/mtab")
+ (when (file-readable-p pcmpl-linux-mtab-file)
(with-temp-buffer
- (insert-file-contents-literally "/etc/mtab")
+ (insert-file-contents-literally pcmpl-linux-mtab-file)
(while (not (eobp))
(let* ((line (buffer-substring (point) (line-end-position)))
(args (split-string line " ")))
diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el
index 52a1dd486bd..efd255908cd 100644
--- a/lisp/pcmpl-rpm.el
+++ b/lisp/pcmpl-rpm.el
@@ -1,4 +1,4 @@
-;;; pcmpl-rpm.el --- functions for dealing with rpm completions
+;;; pcmpl-rpm.el --- functions for dealing with rpm completions -*- lexical-binding: t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -47,14 +47,12 @@
:version "24.3"
:type '(choice (const :tag "No options" nil)
(string :tag "Single option")
- (repeat :tag "List of options" string))
- :group 'pcmpl-rpm)
+ (repeat :tag "List of options" string)))
(defcustom pcmpl-rpm-cache t
"Whether to cache the list of installed packages."
:version "24.3"
- :type 'boolean
- :group 'pcmpl-rpm)
+ :type 'boolean)
(defconst pcmpl-rpm-cache-stamp-file "/var/lib/rpm/Packages"
"File used to check that the list of installed packages is up-to-date.")
@@ -78,7 +76,7 @@
(message "Getting list of installed rpms...")
(setq pcmpl-rpm-cache-time (current-time)
pcmpl-rpm-packages
- (split-string (apply 'pcomplete-process-result "rpm"
+ (split-string (apply #'pcomplete-process-result "rpm"
(append '("-q" "-a")
(if (stringp pcmpl-rpm-query-options)
(list pcmpl-rpm-query-options)
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index f1c8725afea..13de4b65e5b 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -1,4 +1,4 @@
-;;; pcmpl-unix.el --- standard UNIX completions
+;;; pcmpl-unix.el --- standard UNIX completions -*- lexical-binding:t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -82,10 +82,14 @@ being via `pcmpl-ssh-known-hosts-file'."
;;;###autoload
(defun pcomplete/xargs ()
"Completion for `xargs'."
- (pcomplete-here (funcall pcomplete-command-completion-function))
+ ;; FIXME: Add completion of xargs-specific arguments.
+ (funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
+;; FIXME: Add completion of sudo-specific arguments.
+(defalias 'pcomplete/sudo #'pcomplete/xargs)
+
;;;###autoload
(defalias 'pcomplete/time 'pcomplete/xargs)
@@ -144,7 +148,7 @@ documentation), this function returns nil."
;; ssh support by Phil Hagelberg.
-;; http://www.emacswiki.org/cgi-bin/wiki/pcmpl-ssh.el
+;; https://www.emacswiki.org/cgi-bin/wiki/pcmpl-ssh.el
(defun pcmpl-ssh-known-hosts ()
"Return a list of hosts found in `pcmpl-ssh-known-hosts-file'."
@@ -155,12 +159,14 @@ documentation), this function returns nil."
(let ((host-re "\\(?:\\([-.[:alnum:]]+\\)\\|\\[\\([-.[:alnum:]]+\\)\\]:[0-9]+\\)[, ]")
ssh-hosts-list)
(while (re-search-forward (concat "^ *" host-re) nil t)
- (add-to-list 'ssh-hosts-list (concat (match-string 1)
- (match-string 2)))
+ (push (concat (match-string 1)
+ (match-string 2))
+ ssh-hosts-list)
(while (and (eq (char-before) ?,)
(re-search-forward host-re (line-end-position) t))
- (add-to-list 'ssh-hosts-list (concat (match-string 1)
- (match-string 2)))))
+ (push (concat (match-string 1)
+ (match-string 2))
+ ssh-hosts-list)))
ssh-hosts-list))))
(defun pcmpl-ssh-config-hosts ()
@@ -173,7 +179,7 @@ documentation), this function returns nil."
(case-fold-search t))
(while (re-search-forward "^ *host\\(name\\)? +\\([-.[:alnum:]]+\\)"
nil t)
- (add-to-list 'ssh-hosts-list (match-string 2)))
+ (push (match-string 2) ssh-hosts-list))
ssh-hosts-list))))
(defun pcmpl-ssh-hosts ()
@@ -181,7 +187,7 @@ documentation), this function returns nil."
Uses both `pcmpl-ssh-config-file' and `pcmpl-ssh-known-hosts-file'."
(let ((hosts (pcmpl-ssh-known-hosts)))
(dolist (h (pcmpl-ssh-config-hosts))
- (add-to-list 'hosts h))
+ (push h hosts))
hosts))
;;;###autoload
@@ -215,6 +221,29 @@ Includes files as well as host names followed by a colon."
(pcmpl-ssh-hosts)))))))
(complete-with-action action table string pred))))))
+(defsubst pcmpl-unix-complete-hostname ()
+ "Complete a command that wants a hostname for an argument."
+ (pcomplete-here (pcomplete-read-host-names)))
+
+(defalias 'pcomplete/ftp 'pcmpl-unix-complete-hostname)
+(defalias 'pcomplete/ncftp 'pcmpl-unix-complete-hostname)
+(defalias 'pcomplete/ping 'pcmpl-unix-complete-hostname)
+(defalias 'pcomplete/rlogin 'pcmpl-unix-complete-hostname)
+
+;;;###autoload
+(defun pcomplete/telnet ()
+ (pcomplete-opt "xl(pcmpl-unix-user-names)")
+ (pcmpl-unix-complete-hostname))
+
+;;;###autoload
+(defun pcomplete/rsh ()
+ "Complete `rsh', which, after the user and hostname, is like xargs."
+ (pcomplete-opt "l(pcmpl-unix-user-names)")
+ (pcmpl-unix-complete-hostname)
+ (pcomplete-here (funcall pcomplete-command-completion-function))
+ (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
+ pcomplete-default-completion-function)))
+
(provide 'pcmpl-unix)
;;; pcmpl-unix.el ends here
diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el
index 5244ada5231..0fd426e3d1f 100644
--- a/lisp/pcmpl-x.el
+++ b/lisp/pcmpl-x.el
@@ -141,7 +141,7 @@
(pcomplete-here* (pcomplete-dirs-or-entries)))))))
-;;;; ack - http://betterthangrep.com
+;;;; ack - https://betterthangrep.com
;; Usage:
;; - To complete short options type '-' first
@@ -286,5 +286,37 @@ long options."
(pcmpl-x-ag-options))))
(pcomplete-here* (pcomplete-dirs-or-entries)))))
+;;;###autoload
+(defun pcomplete/bcc32 ()
+ "Completion function for Borland's C++ compiler."
+ (let ((cur (pcomplete-arg 0)))
+ (cond
+ ((string-match "\\`-w\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
+ (pcomplete-here
+ '("ali" "amb" "amp" "asc" "asm" "aus" "bbf" "bei" "big" "ccc"
+ "cln" "cod" "com" "cpt" "csu" "def" "dig" "dpu" "dsz" "dup"
+ "eas" "eff" "ext" "hch" "hid" "ias" "ibc" "ifr" "ill" "nil"
+ "lin" "lvc" "mcs" "mes" "mpc" "mpd" "msg" "nak" "ncf" "nci"
+ "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf"
+ "nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par"
+ "pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret"
+ "rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai"
+ "tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur)))
+ ((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
+ (pcomplete-here (pcomplete-dirs) (match-string 2 cur)))
+ ((string-match "\\`-[Ee]\\(.*\\)\\'" cur)
+ (pcomplete-here (pcomplete-dirs-or-entries "\\.[Ee][Xx][Ee]\\'")
+ (match-string 1 cur)))
+ ((string-match "\\`-o\\(.*\\)\\'" cur)
+ (pcomplete-here (pcomplete-dirs-or-entries "\\.[Oo][Bb][Jj]\\'")
+ (match-string 1 cur)))
+ (t
+ (pcomplete-opt "3456ABCDEHIKLMNOPRSTUVXabcdefgijklnoptuvwxyz"))))
+ (while (pcomplete-here
+ (pcomplete-dirs-or-entries "\\.[iCc]\\([Pp][Pp]\\)?\\'"))))
+
+;;;###autoload
+(defalias 'pcomplete/bcc 'pcomplete/bcc32)
+
(provide 'pcmpl-x)
;;; pcmpl-x.el ends here
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 32e61e84e0d..a744165e0d5 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -291,9 +291,8 @@ generate the completions list. This means that the hook
`(pcomplete--here (lambda () ,form) ,stub ,paring ,form-only))
(defcustom pcomplete-command-completion-function
- (function
- (lambda ()
- (pcomplete-here (pcomplete-executables))))
+ (lambda ()
+ (pcomplete-here (pcomplete-executables)))
"Function called for completing the initial command argument."
:type 'function)
@@ -302,9 +301,8 @@ generate the completions list. This means that the hook
:type 'function)
(defcustom pcomplete-default-completion-function
- (function
- (lambda ()
- (while (pcomplete-here (pcomplete-entries)))))
+ (lambda ()
+ (while (pcomplete-here (pcomplete-entries))))
"Function called when no completion rule can be found.
This function is used to generate completions for every argument."
:type 'function)
@@ -325,6 +323,10 @@ already terminated by a character, this variable should be locally
modified to be an empty string, or the desired separation string."
:type 'string)
+(defcustom pcomplete-hosts-file "/etc/hosts"
+ "The name of the /etc/hosts file."
+ :type '(choice (const :tag "No hosts file" nil) file))
+
;;; Internal Variables:
;; for cycling completion support
@@ -348,7 +350,7 @@ modified to be an empty string, or the desired separation string."
(defvar pcomplete-show-list nil)
(defvar pcomplete-expand-only-p nil)
-;; for the sake of the bye-compiler, when compiling other files that
+;; for the sake of the byte-compiler, when compiling other files that
;; contain completion functions
(defvar pcomplete-args nil)
(defvar pcomplete-begins nil)
@@ -984,9 +986,8 @@ Arguments NO-GANGING and ARGS-FOLLOW are currently ignored."
(setq index (1+ index))))
(throw 'pcomplete-completions
(mapcar
- (function
- (lambda (opt)
- (concat "-" opt)))
+ (lambda (opt)
+ (concat "-" opt))
(pcomplete-uniquify-list choices))))
(let ((arg (pcomplete-arg)))
(when (and (> (length arg) 1)
@@ -1289,6 +1290,46 @@ If specific documentation can't be given, be generic."
(skip-chars-backward "\n")
(buffer-substring (point-min) (point))))
+;; hostname completion
+
+(defvar pcomplete--host-name-cache nil
+ "A cache the names of frequently accessed hosts.")
+
+(defvar pcomplete--host-name-cache-timestamp nil
+ "A timestamp of when the hosts file was read.")
+
+(defun pcomplete-read-hosts-file (filename)
+ "Read in the hosts from FILENAME, default `pcomplete-hosts-file'."
+ (let (hosts)
+ (with-temp-buffer
+ (insert-file-contents (or filename pcomplete-hosts-file))
+ (goto-char (point-min))
+ (while (re-search-forward
+ ;; "^ \t\\([^# \t\n]+\\)[ \t]+\\([^ \t\n]+\\)\\([ \t]*\\([^ \t\n]+\\)\\)?"
+ "^[ \t]*\\([^# \t\n]+\\)[ \t]+\\([^ \t\n].+\\)" nil t)
+ (push (cons (match-string 1)
+ (split-string (match-string 2)))
+ hosts)))
+ (nreverse hosts)))
+
+(defun pcomplete-read-hosts (file result-var timestamp-var)
+ "Read the contents of /etc/hosts for host names."
+ (if (or (not (symbol-value result-var))
+ (not (symbol-value timestamp-var))
+ (time-less-p
+ (symbol-value timestamp-var)
+ (file-attribute-modification-time (file-attributes file))))
+ (progn
+ (set result-var (apply #'nconc (pcomplete-read-hosts-file file)))
+ (set timestamp-var (current-time))))
+ (symbol-value result-var))
+
+(defun pcomplete-read-host-names ()
+ "Read the contents of /etc/hosts for host names."
+ (if pcomplete-hosts-file
+ (pcomplete-read-hosts pcomplete-hosts-file 'pcomplete--host-name-cache
+ 'pcomplete--host-name-cache-timestamp)))
+
;; create a set of aliases which allow completion functions to be not
;; quite so verbose
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index bd05d91e2da..9e86e4695bd 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -26,9 +26,8 @@
;;
;; M-x pixel-scroll-mode RET
;;
-;; To make the mode permanent, put these in your init file:
+;; To make the mode permanent, put this in your Init file:
;;
-;; (require 'pixel-scroll)
;; (pixel-scroll-mode 1)
;;; Commentary:
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 7c4941e7256..3d4843a39c6 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -582,7 +582,7 @@ Solutions are sorted from least to greatest Hamming weight."
(math-sub dest org))))
;; transferm is the transfer matrix, ie it is the 25x25
- ;; matrix applied everytime a flip is carried out where a
+ ;; matrix applied every time a flip is carried out where a
;; flip is defined by a 25x1 Dirac vector --- ie all zeros
;; but 1 in the position that is flipped.
(transferm
diff --git a/lisp/play/animate.el b/lisp/play/animate.el
index ff464b68049..8dec55178b1 100644
--- a/lisp/play/animate.el
+++ b/lisp/play/animate.el
@@ -1,4 +1,4 @@
-;;; animate.el --- make text dance
+;;; animate.el --- make text dance -*- lexical-binding:t -*-
;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
@@ -84,7 +84,7 @@
(defun animate-place-char (char vpos hpos)
(goto-char (window-start))
(let (abbrev-mode)
- (dotimes (i vpos)
+ (dotimes (_ vpos)
(end-of-line)
(if (= (forward-line 1) 1)
(insert "\n"))))
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index 6842cb06302..ca23a78202e 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -28,14 +28,7 @@
;; possible in as few moves as possible.
;; Bubbles is an implementation of the "Same Game", similar to "Same
-;; GNOME" and many others, see <http://en.wikipedia.org/wiki/SameGame>.
-
-;; Installation
-;; ------------
-
-;; Add the following lines to your init file:
-;; (add-to-list 'load-path "/path/to/bubbles/")
-;; (autoload 'bubbles "bubbles" "Play Bubbles" t)
+;; GNOME" and many others, see <https://en.wikipedia.org/wiki/SameGame>.
;; ======================================================================
@@ -80,6 +73,7 @@
;;; Code:
(defconst bubbles-version "0.5" "Version number of bubbles.el.")
+(make-obsolete-variable 'bubbles-version nil "28.1")
(require 'gamegrid)
@@ -975,16 +969,14 @@ Set `bubbles--col-offset' and `bubbles--row-offset'."
(* image-vert-size (bubbles--grid-height)))
2)))))
-(defun bubbles--remove-overlays ()
- "Remove all overlays."
- (if (fboundp 'remove-overlays)
- (remove-overlays)))
+(define-obsolete-function-alias 'bubbles--remove-overlays
+ 'remove-overlays "28.1")
(defun bubbles--initialize ()
"Initialize Bubbles game."
(bubbles--initialize-faces)
(bubbles--initialize-images)
- (bubbles--remove-overlays)
+ (remove-overlays)
(switch-to-buffer (get-buffer-create "*bubbles*"))
(bubbles--compute-offsets)
@@ -1408,7 +1400,7 @@ Return t if new char is non-empty."
(defun bubbles--show-images ()
"Update images in the bubbles buffer."
- (bubbles--remove-overlays)
+ (remove-overlays)
(if (and (display-images-p)
bubbles--images-ok
(not (eq bubbles-graphics-theme 'ascii)))
diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el
index 3768a14ad82..9a6300c0fd2 100644
--- a/lisp/play/dissociate.el
+++ b/lisp/play/dissociate.el
@@ -1,4 +1,4 @@
-;;; dissociate.el --- scramble text amusingly for Emacs
+;;; dissociate.el --- scramble text amusingly for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index a03d0a9a052..8a69f9decf0 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -4,7 +4,7 @@
;; Author: Ron Schnell <ronnie@driver-aces.com>
;; Created: 25 Jul 1992
-;; Version: 2.02
+;; Old-Version: 2.02
;; Keywords: games
;; This file is part of GNU Emacs.
@@ -1957,7 +1957,7 @@ to swim.")
(defun dun-help (_args)
(dun-mprincl
-"Welcome to dunnet (2.02), by Ron Schnell (ronnie@driver-aces.com - @RonnieSchnell).
+"Welcome to dunnet by Ron Schnell (ronnie@driver-aces.com - @RonnieSchnell).
Here is some useful information (read carefully because there are one
or more clues in here):
- If you have a key that can open a door, you do not need to explicitly
diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el
index f8859d954f8..c180fd06c34 100644
--- a/lisp/play/fortune.el
+++ b/lisp/play/fortune.el
@@ -1,4 +1,4 @@
-;;; fortune.el --- use fortune to create signatures
+;;; fortune.el --- use fortune to create signatures -*- lexical-binding: t -*-
;; Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
@@ -63,76 +63,75 @@
:link '(emacs-commentary-link "fortune.el")
:version "21.1"
:group 'games)
-(defgroup fortune-signature nil
- "Settings for use of fortune for signatures."
- :group 'fortune
- :group 'mail)
(defcustom fortune-dir "~/docs/ascii/misc/fortunes/"
"The directory to look in for local fortune cookies files."
- :type 'directory
- :group 'fortune)
+ :type 'directory)
+
(defcustom fortune-file
(expand-file-name "usenet" fortune-dir)
"The file in which local fortune cookies will be stored."
- :type 'file
- :group 'fortune)
+ :type 'file)
+
(defcustom fortune-database-extension ".dat"
"The extension of the corresponding fortune database.
Normally you won't have a reason to change it."
- :type 'string
- :group 'fortune)
+ :type 'string)
+
(defcustom fortune-program "fortune"
"Program to select a fortune cookie."
- :type 'string
- :group 'fortune)
+ :type 'string)
+
(defcustom fortune-program-options ()
"List of options to pass to the fortune program."
:type '(choice (repeat (string :tag "Option"))
(string :tag "Obsolete string of options"))
- :version "23.1"
- :group 'fortune)
+ :version "23.1")
+
(defcustom fortune-strfile "strfile"
"Program to compute a new fortune database."
- :type 'string
- :group 'fortune)
+ :type 'string)
+
(defcustom fortune-strfile-options ""
"Options to pass to the strfile program (a string)."
- :type 'string
- :group 'fortune)
+ :type 'string)
+
(defcustom fortune-quiet-strfile-options "> /dev/null"
"Text added to the command for running `strfile'.
By default it discards the output produced by `strfile'.
Set this to \"\" if you would like to see the output."
- :type 'string
- :group 'fortune)
+ :type 'string)
(defcustom fortune-always-compile t
"Non-nil means automatically compile fortune files.
If nil, you must invoke `fortune-compile' manually to do that."
- :type 'boolean
- :group 'fortune)
+ :type 'boolean)
+
+(defgroup fortune-signature nil
+ "Settings for use of fortune for signatures."
+ :group 'fortune
+ :group 'mail)
+
(defcustom fortune-author-line-prefix " -- "
"Prefix to put before the author name of a fortunate."
- :type 'string
- :group 'fortune-signature)
+ :type 'string)
+
(defcustom fortune-fill-column fill-column
"Fill column for fortune files."
- :type 'integer
- :group 'fortune-signature)
+ :type 'integer)
+
(defcustom fortune-from-mail "private e-mail"
"String to use to characterize that the fortune comes from an e-mail.
No need to add an `in'."
- :type 'string
- :group 'fortune-signature)
+ :type 'string)
+
(defcustom fortune-sigstart ""
"Some text to insert before the fortune cookie, in a mail signature."
- :type 'string
- :group 'fortune-signature)
+ :type 'string)
+
(defcustom fortune-sigend ""
"Some text to insert after the fortune cookie, in a mail signature."
- :type 'string
- :group 'fortune-signature)
+ :type 'string)
;; not customizable settings
@@ -297,7 +296,7 @@ specifies the file to choose the fortune from."
(erase-buffer)
(if fortune-always-compile
(fortune-compile fort-file))
- (apply 'call-process
+ (apply #'call-process
fortune-program ; program to call
nil fortune-buffer nil ; INFILE BUFFER DISPLAY
(append (if (stringp fortune-program-options)
@@ -334,7 +333,6 @@ and choose the directory as the fortune-file."
(setq buffer-read-only t))
-;;; Provide ourselves.
(provide 'fortune)
;;; fortune.el ends here
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index f0132135fd9..bb8ae5693f6 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -3,7 +3,7 @@
;; Copyright (C) 1997-1998, 2001-2020 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
-;; Version: 1.02
+;; Old-Version: 1.02
;; Created: 1997-08-13
;; Keywords: games
@@ -265,12 +265,7 @@ format."
(set-face-foreground face color)
(set-face-background face color)
(gamegrid-set-font face)
- (condition-case nil
- (set-face-background-pixmap face [nothing]);; XEmacs
- (error nil))
- (condition-case nil
- (set-face-background-pixmap face nil);; Emacs
- (error nil)))
+ (set-face-background-pixmap face nil))
(defun gamegrid-make-mono-tty-face ()
(let ((face (make-face 'gamegrid-mono-tty-face)))
@@ -640,6 +635,8 @@ FILE is created there."
(save-excursion
(setq file (expand-file-name file (or directory
temporary-file-directory)))
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
(find-file-other-window file)
(setq buffer-read-only nil)
(goto-char (point-max))
diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el
index aa99b553244..a9417e9e0ac 100644
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -121,8 +121,8 @@ Has to contain \"%d\" to output the actual number."
:group 'gametree)
(defcustom gametree-make-heading-function
- (function (lambda (level)
- (insert (make-string level ?*))))
+ (lambda (level)
+ (insert (make-string level ?*)))
"A function of one numeric argument, LEVEL, to insert a heading at point.
You should change this if you change `outline-regexp'."
:type 'function
@@ -324,7 +324,7 @@ This value is simply the outline heading level of the current line."
(defun gametree-hack-file-layout ()
(save-excursion
(goto-char (point-min))
- (if (looking-at "[^\n]*-*-[^\n]*gametree-local-layout: \\([^;\n]*\\);")
+ (if (looking-at "[^\n]*-[^\n]*gametree-local-layout: \\([^;\n]*\\);")
(progn
(goto-char (match-beginning 1))
(delete-region (point) (match-end 1))
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index 6e0061d461a..403398672b1 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -110,8 +110,8 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
(define-key map "u" 'gomoku-move-ne) ; u
(define-key map "b" 'gomoku-move-sw) ; b
(define-key map "n" 'gomoku-move-se) ; n
- (define-key map "h" 'backward-char) ; h
- (define-key map "l" 'forward-char) ; l
+ (define-key map "h" 'gomoku-move-left) ; h
+ (define-key map "l" 'gomoku-move-right) ; l
(define-key map "j" 'gomoku-move-down) ; j
(define-key map "k" 'gomoku-move-up) ; k
@@ -119,11 +119,13 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
(define-key map [kp-9] 'gomoku-move-ne)
(define-key map [kp-1] 'gomoku-move-sw)
(define-key map [kp-3] 'gomoku-move-se)
- (define-key map [kp-4] 'backward-char)
- (define-key map [kp-6] 'forward-char)
+ (define-key map [kp-4] 'gomoku-move-left)
+ (define-key map [kp-6] 'gomoku-move-right)
(define-key map [kp-2] 'gomoku-move-down)
(define-key map [kp-8] 'gomoku-move-up)
+ (define-key map "\C-b" 'gomoku-move-left) ; C-b
+ (define-key map "\C-f" 'gomoku-move-right) ; C-f
(define-key map "\C-n" 'gomoku-move-down) ; C-n
(define-key map "\C-p" 'gomoku-move-up) ; C-p
@@ -146,6 +148,10 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
(define-key map [mouse-2] 'gomoku-mouse-play)
(define-key map [drag-mouse-2] 'gomoku-mouse-play)
+ (define-key map [remap backward-char] 'gomoku-move-left)
+ (define-key map [remap left-char] 'gomoku-move-left)
+ (define-key map [remap forward-char] 'gomoku-move-right)
+ (define-key map [remap right-char] 'gomoku-move-right)
(define-key map [remap previous-line] 'gomoku-move-up)
(define-key map [remap next-line] 'gomoku-move-down)
(define-key map [remap move-beginning-of-line] 'gomoku-beginning-of-line)
@@ -954,6 +960,11 @@ If the game is finished, this command requests for another game."
;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line !
gomoku-square-height)))
+(defun gomoku-point-x ()
+ "Return the board column where point is."
+ (1+ (/ (- (current-column) gomoku-x-offset)
+ gomoku-square-width)))
+
(defun gomoku-point-y ()
"Return the board row where point is."
(1+ (/ (- (count-lines (point-min) (point))
@@ -1143,13 +1154,28 @@ If the game is finished, this command requests for another game."
(skip-chars-forward gomoku--intangible-chars)
(when (eobp)
(skip-chars-backward gomoku--intangible-chars)
- (forward-char -1)))
+ (gomoku-move-left)))
(skip-chars-backward gomoku--intangible-chars)
(if (bobp)
(skip-chars-forward gomoku--intangible-chars)
- (forward-char -1))))
+ (gomoku-move-left))))
(setq gomoku--last-pos (point)))
+;; forward-char and backward-char don't always move the right number
+;; of characters. Also, these functions check if you're on the edge of
+;; the screen.
+(defun gomoku-move-right ()
+ "Move point right one column on the Gomoku board."
+ (interactive)
+ (when (< (gomoku-point-x) gomoku-board-width)
+ (forward-char gomoku-square-width)))
+
+(defun gomoku-move-left ()
+ "Move point left one column on the Gomoku board."
+ (interactive)
+ (when (> (gomoku-point-x) 1)
+ (backward-char gomoku-square-width)))
+
;; previous-line and next-line don't work right with intangible newlines
(defun gomoku-move-down ()
"Move point down one row on the Gomoku board."
@@ -1171,25 +1197,25 @@ If the game is finished, this command requests for another game."
"Move point North East on the Gomoku board."
(interactive)
(gomoku-move-up)
- (forward-char))
+ (gomoku-move-right))
(defun gomoku-move-se ()
"Move point South East on the Gomoku board."
(interactive)
(gomoku-move-down)
- (forward-char))
+ (gomoku-move-right))
(defun gomoku-move-nw ()
"Move point North West on the Gomoku board."
(interactive)
(gomoku-move-up)
- (backward-char))
+ (gomoku-move-left))
(defun gomoku-move-sw ()
"Move point South West on the Gomoku board."
(interactive)
(gomoku-move-down)
- (backward-char))
+ (gomoku-move-left))
(defun gomoku-beginning-of-line ()
"Move point to first square on the Gomoku board row."
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 7b4a59b6fcd..1cf690a86db 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -41,16 +41,8 @@
;; If you are not satisfied with the type page there are a number of
;; variables you may want to set.
;;
-;;
-;; Installation
-;;
-;; type at your prompt "emacs -l handwrite.el" or put this file on your
-;; Emacs Lisp load path, add the following into your init file:
-;;
-;; (require 'handwrite)
-;;
-;; "M-x handwrite" or "Write by hand" in the edit menu should work now.
-;;
+;; To use this, say "M-x handwrite" or type at your prompt
+;; "emacs -l handwrite.el".
;;
;; I tried to make it `iso_8859_1'-friendly, but there are some exotic
;; characters missing.
diff --git a/lisp/play/life.el b/lisp/play/life.el
index 06d5b4082ff..56ecc5273da 100644
--- a/lisp/play/life.el
+++ b/lisp/play/life.el
@@ -1,4 +1,4 @@
-;;; life.el --- John Horton Conway's `Life' game for GNU Emacs
+;;; life.el --- John Horton Conway's Game of Life -*- lexical-binding:t -*-
;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
@@ -29,6 +29,15 @@
;;; Code:
+(defgroup life nil
+ "Conway's Game of Life."
+ :group 'games)
+
+(defcustom life-step-time 0.5
+ "Time to sleep between steps (generations)."
+ :type 'number
+ :version "28.1")
+
(defvar life-patterns
[("@@@" " @@" "@@@")
("@@@ @@@" "@@ @@ " "@@@ @@@")
@@ -54,6 +63,7 @@
" @@")
("@@@@@@@@@" "@ @ @" "@ @@@@@ @" "@ @ @ @" "@@@ @@@"
"@ @ @ @" "@ @@@@@ @" "@ @ @" "@@@@@@@@@")
+ ;; Glider Gun (infinite, Bill Gosper, 1970)
(" @ "
" @ @ "
" @@ @@ @@"
@@ -74,7 +84,26 @@
" @@"
" @@ @"
"@ @ @")
- ("@@@@@@@@ @@@@@ @@@ @@@@@@@ @@@@@")]
+ ("@@@@@@@@ @@@@@ @@@ @@@@@@@ @@@@@")
+ ;; Pentadecathlon (period 15, John Conway, 1970)
+ (" @ @ "
+ "@@ @@@@ @@"
+ " @ @ ")
+ ;; Queen Bee Shuttle (period 30, Bill Gosper, 1970)
+ (" @ "
+ " @ @ "
+ " @ @ "
+ "@@ @ @ @@"
+ "@@ @ @ @@"
+ " @ @ "
+ " @ ")
+ ;; 2x Figure eight (period 8, Simon Norton, 1970)
+ ("@@@ @@@ "
+ "@@@ @@@ "
+ "@@@ @@@ "
+ " @@@ @@@"
+ " @@@ @@@"
+ " @@@ @@@")]
"Vector of rectangles containing some Life startup patterns.")
;; Macros are used macros for manifest constants instead of variables
@@ -106,28 +135,45 @@
;; (scroll-up) and (scroll-down) when trying to center the display.
(defvar life-window-start nil)
+(defvar life--max-width nil
+ "If non-nil, restrict width to this positive integer. ")
+
+(defvar life--max-height nil
+ "If non-nil, restrict height to this positive integer. ")
+
;; For mode line
(defvar life-current-generation nil)
;; Sadly, mode-line-format won't display numbers.
(defvar life-generation-string nil)
+(defun life--tick ()
+ "Game tick for `life'."
+ (let ((inhibit-quit t)
+ (inhibit-read-only t))
+ (life-grim-reaper)
+ (life-expand-plane-if-needed)
+ (life-increment-generation)))
+
;;;###autoload
-(defun life (&optional sleeptime)
+(defun life (&optional step-time)
"Run Conway's Life simulation.
-The starting pattern is randomly selected. Prefix arg (optional first
-arg non-nil from a program) is the number of seconds to sleep between
-generations (this defaults to 1)."
- (interactive "p")
- (or sleeptime (setq sleeptime 1))
+The starting pattern is randomly selected from `life-patterns'.
+
+Prefix arg is the number of tenths of a second to sleep between
+generations (the default is `life-step-time').
+
+When called from Lisp, optional argument STEP-TIME is the time to
+sleep in seconds."
+ (interactive "P")
+ (setq step-time (or (and step-time (/ (if (consp step-time)
+ (car step-time)
+ step-time) 10.0))
+ life-step-time))
(life-setup)
(catch 'life-exit
(while t
- (let ((inhibit-quit t)
- (inhibit-read-only t))
- (life-display-generation sleeptime)
- (life-grim-reaper)
- (life-expand-plane-if-needed)
- (life-increment-generation)))))
+ (life-display-generation step-time)
+ (life--tick))))
(define-derived-mode life-mode special-mode "Life"
"Major mode for the buffer of `life'."
@@ -138,16 +184,17 @@ generations (this defaults to 1)."
(setq-local life-generation-string "0")
(setq-local mode-line-buffer-identification '("Life: generation "
life-generation-string))
- (setq-local fill-column (1- (window-width)))
+ (setq-local fill-column (min (or life--max-width most-positive-fixnum)
+ (1- (window-width))))
(setq-local life-window-start 1)
(buffer-disable-undo))
(defun life-setup ()
(switch-to-buffer (get-buffer-create "*Life*") t)
- (erase-buffer)
- (life-mode)
;; stuff in the random pattern
(let ((inhibit-read-only t))
+ (erase-buffer)
+ (life-mode)
(life-insert-random-pattern)
;; make sure (life-life-char) is used throughout
(goto-char (point-min))
@@ -160,7 +207,8 @@ generations (this defaults to 1)."
(indent-to n)
(forward-line)))
;; center the pattern vertically
- (let ((n (/ (- (1- (window-height))
+ (let ((n (/ (- (min (or life--max-height most-positive-fixnum)
+ (1- (window-height)))
(count-lines (point-min) (point-max)))
2)))
(goto-char (point-min))
@@ -276,12 +324,12 @@ generations (this defaults to 1)."
(insert ?\n)
(setq life-window-start (+ life-window-start fill-column 1)))))
-(defun life-display-generation (sleeptime)
+(defun life-display-generation (step-time)
(goto-char life-window-start)
(recenter 0)
;; Redisplay; if the user has hit a key, exit the loop.
- (or (and (sit-for sleeptime) (< 0 sleeptime))
+ (or (and (sit-for step-time) (< 0 step-time))
(not (input-pending-p))
(throw 'life-exit nil)))
diff --git a/lisp/play/pong.el b/lisp/play/pong.el
index d5723344a0d..4e6d73b6e94 100644
--- a/lisp/play/pong.el
+++ b/lisp/play/pong.el
@@ -1,4 +1,4 @@
-;;; pong.el --- classical implementation of pong
+;;; pong.el --- classical implementation of pong -*- lexical-binding:t -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -33,88 +33,72 @@
;;; Customization
(defgroup pong nil
- "Emacs-Lisp implementation of the classical game pong."
+ "Emacs Lisp implementation of the classical game pong."
:tag "Pong"
:group 'games)
(defcustom pong-buffer-name "*Pong*"
"Name of the buffer used to play."
- :group 'pong
:type '(string))
(defcustom pong-width 50
"Width of the playfield."
- :group 'pong
:type '(integer))
(defcustom pong-height (min 30 (- (frame-height) 6))
"Height of the playfield."
- :group 'pong
:type '(integer))
(defcustom pong-bat-width 3
"Width of the bats for pong."
- :group 'pong
:type '(integer))
(defcustom pong-blank-color "black"
"Color used for background."
- :group 'pong
:type 'color)
(defcustom pong-bat-color "yellow"
"Color used for bats."
- :group 'pong
:type 'color)
(defcustom pong-ball-color "red"
"Color used for the ball."
- :group 'pong
:type 'color)
(defcustom pong-border-color "white"
"Color used for pong borders."
- :group 'pong
:type 'color)
(defcustom pong-left-key "4"
"Alternate key to press for bat 1 to go up (primary one is [left])."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-right-key "6"
"Alternate key to press for bat 1 to go down (primary one is [right])."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-up-key "8"
"Alternate key to press for bat 2 to go up (primary one is [up])."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-down-key "2"
"Alternate key to press for bat 2 to go down (primary one is [down])."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-quit-key "q"
"Key to press to quit pong."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-pause-key "p"
"Key to press to pause pong."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-resume-key "p"
"Key to press to resume pong."
- :group 'pong
:type '(restricted-sexp :match-alternatives (stringp vectorp)))
(defcustom pong-timer-delay 0.1
"Time to wait between every cycle."
- :group 'pong
:type 'number)
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index d7c0683a05f..8ea214d8025 100644
--- a/lisp/play/snake.el
+++ b/lisp/play/snake.el
@@ -1,4 +1,4 @@
-;;; snake.el --- implementation of Snake for Emacs
+;;; snake.el --- implementation of Snake for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
@@ -192,6 +192,7 @@ and then start moving it leftwards.")
(defvar snake-null-map
(let ((map (make-sparse-keymap 'snake-null-map)))
(define-key map "n" 'snake-start-game)
+ (define-key map "q" 'quit-window)
map)
"Keymap for finished Snake games.")
@@ -278,7 +279,7 @@ and then start moving it leftwards.")
snake-velocity-queue nil)
(let ((x snake-initial-x)
(y snake-initial-y))
- (dotimes (i snake-length)
+ (dotimes (_ snake-length)
(gamegrid-set-cell x y snake-snake)
(setq snake-positions (cons (vector x y) snake-positions))
(cl-incf x snake-velocity-x)
diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el
index 5c1dd061c9c..1383efe37cd 100644
--- a/lisp/play/solitaire.el
+++ b/lisp/play/solitaire.el
@@ -1,4 +1,4 @@
-;;; solitaire.el --- game of solitaire in Emacs Lisp
+;;; solitaire.el --- game of solitaire in Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 1994, 2001-2020 Free Software Foundation, Inc.
@@ -38,8 +38,7 @@
(defcustom solitaire-mode-hook nil
"Hook to run upon entry to Solitaire."
- :type 'hook
- :group 'solitaire)
+ :type 'hook)
(defvar solitaire-mode-map
(let ((map (make-sparse-keymap)))
@@ -119,8 +118,7 @@ The usual mnemonic keys move the cursor around the board; in addition,
"Non-nil means check for possible moves after each major change.
This takes a while, so switch this on if you like to be informed when
the game is over, or off, if you are working on a slow machine."
- :type 'boolean
- :group 'solitaire)
+ :type 'boolean)
(defconst solitaire-valid-directions
'(solitaire-left solitaire-right solitaire-up solitaire-down))
diff --git a/lisp/play/spook.el b/lisp/play/spook.el
index 8e69cd971bb..ed91dadcbca 100644
--- a/lisp/play/spook.el
+++ b/lisp/play/spook.el
@@ -1,4 +1,4 @@
-;;; spook.el --- spook phrase utility for overloading the NSA line eater
+;;; spook.el --- spook phrase utility for overloading the NSA line eater -*- lexical-binding:t -*-
;; Copyright (C) 1988, 1993, 2001-2020 Free Software Foundation, Inc.
@@ -45,13 +45,11 @@
(defcustom spook-phrases-file (expand-file-name "spook.lines" data-directory)
"Keep your favorite phrases here."
- :type 'file
- :group 'spook)
+ :type 'file)
(defcustom spook-phrase-default-count 15
"Default number of phrases to insert."
- :type 'integer
- :group 'spook)
+ :type 'integer)
;;;###autoload
(defun spook ()
diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index 97979b5b6b6..e25cacbb722 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -1,4 +1,4 @@
-;;; tetris.el --- implementation of Tetris for Emacs
+;;; tetris.el --- implementation of Tetris for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/printing.el b/lisp/printing.el
index 0c564237da6..90ef02fe7b1 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -5,7 +5,7 @@
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
;; Version: 6.9.3
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
(defconst pr-version "6.9.3"
"printing.el, v 6.9.3 <2007/12/09 vinicius>
@@ -64,7 +64,7 @@ Please send all bug fixes and enhancements to
;; interface to ps-print package and it also provides some extra stuff.
;;
;; To download the latest ps-print package see
-;; `http://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'.
+;; `https://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'.
;; Please, see README file for ps-print installation instructions.
;;
;; `printing' was inspired by:
@@ -944,8 +944,8 @@ Please send all bug fixes and enhancements to
;;
;; * For `printing' package:
;;
-;; printing `http://www.emacswiki.org/cgi-bin/emacs/download/printing.el'
-;; ps-print `http://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'
+;; printing `https://www.emacswiki.org/cgi-bin/emacs/download/printing.el'
+;; ps-print `https://www.emacswiki.org/cgi-bin/wiki/PsPrintPackage'
;;
;; * For GNU or Unix system:
;;
@@ -5284,22 +5284,18 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-interactive-n-up (mess)
- (or (stringp mess) (setq mess "*"))
- (save-match-data
- (let* ((fmt-prompt "%s[%s] N-up printing (default 1): ")
- (prompt "")
- (str (read-string (format fmt-prompt prompt mess) nil nil "1"))
- int)
- (while (if (string-match "^\\s *[0-9]+$" str)
- (setq int (string-to-number str)
- prompt (cond ((< int 1) "Integer below 1; ")
- ((> int 100) "Integer above 100; ")
- (t nil)))
- (setq prompt "Invalid integer syntax; "))
- (ding)
- (setq str
- (read-string (format fmt-prompt prompt mess) str nil "1")))
- int)))
+ (unless (stringp mess)
+ (setq mess "*"))
+ (let (int)
+ (while (or (< (setq int (read-number (format "[%s] N-up printing:" mess) 1))
+ 0)
+ (> int 100))
+ (if (< int 0)
+ (message "Integer below 1")
+ (message "Integer above 100"))
+ (sit-for 1)
+ (ding))
+ int))
(defun pr-interactive-dir (mess)
@@ -5323,7 +5319,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-interactive-regexp (mess)
- (read-string (format "[%s] File regexp to print: " mess) nil nil ""))
+ (read-string (format "[%s] File regexp to print: " mess)))
(defun pr-interactive-dir-args (mess)
@@ -5622,8 +5618,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; header
(let ((versions (concat "printing v" pr-version
" ps-print v" ps-print-version)))
- ;; to keep compatibility with Emacs 20 & 21:
- ;; DO NOT REPLACE `?\ ' BY `?\s'
(widget-insert (make-string (- 79 (length versions)) ?\ ) versions))
(pr-insert-italic "\nCurrent Directory : " 1)
(pr-insert-italic default-directory)
diff --git a/lisp/proced.el b/lisp/proced.el
index ff2db33afb6..203d70331ce 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -1,4 +1,4 @@
-;;; proced.el --- operate on system processes like dired
+;;; proced.el --- operate on system processes like dired -*- lexical-binding:t -*-
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
@@ -55,17 +55,15 @@
:group 'unix
:prefix "proced-")
-(defcustom proced-signal-function 'signal-process
+(defcustom proced-signal-function #'signal-process
"Name of signal function.
It can be an elisp function (usually `signal-process') or a string specifying
the external command (usually \"kill\")."
- :group 'proced
:type '(choice (function :tag "function")
(string :tag "command")))
(defcustom proced-renice-command "renice"
"Name of renice command."
- :group 'proced
:version "24.3"
:type '(string :tag "command"))
@@ -95,7 +93,6 @@ the external command (usually \"kill\")."
("USR1" . " (User-defined signal 1)")
("USR2" . " (User-defined signal 2)"))
"List of signals, used for minibuffer completion."
- :group 'proced
:type '(repeat (cons (string :tag "signal name")
(string :tag "description"))))
@@ -205,7 +202,6 @@ of point. The function must return a list of PIDs that is used for the refined
listing. HELP-ECHO is a string that is shown when mouse is over this field.
If REFINER is nil no refinement is done."
- :group 'proced
:type '(repeat (list :tag "Attribute"
(symbol :tag "Key")
(string :tag "Header")
@@ -239,7 +235,6 @@ of a system process. It returns a cons cell of the form (KEY . VALUE)
like `process-attributes'. This cons cell is appended to the list
returned by `proced-process-attributes'.
If the function returns nil, the value is ignored."
- :group 'proced
:type '(repeat (function :tag "Attribute")))
;; Formatting and sorting rules are defined "per attribute". If formatting
@@ -263,7 +258,6 @@ The cdr is a list of attribute keys appearing in `proced-grammar-alist'.
An element of this list may also be a list of attribute keys that specifies
alternatives. If the first attribute is absent for a process, use the second
one, etc."
- :group 'proced
:type '(alist :key-type (symbol :tag "Format Name")
:value-type (repeat :tag "Keys"
(choice (symbol :tag "")
@@ -274,7 +268,6 @@ one, etc."
"Current format of Proced listing.
It can be the car of an element of `proced-format-alist'.
It can also be a list of keys appearing in `proced-grammar-alist'."
- :group 'proced
:type '(choice (symbol :tag "Format Name")
(repeat :tag "Keys" (symbol :tag ""))))
(make-variable-buffer-local 'proced-format)
@@ -304,7 +297,6 @@ An elementary filter can be one of the following:
of each. Accept the process if FUN returns non-nil.
\(fun-all . FUN) Apply function FUN to entire process list.
FUN must return the filtered list."
- :group 'proced
:type '(repeat (cons :tag "Filter"
(symbol :tag "Filter Name")
(repeat :tag "Filters"
@@ -318,7 +310,6 @@ An elementary filter can be one of the following:
It can be the car of an element of `proced-filter-alist'.
It can also be a list of elementary filters as in the cdrs of the elements
of `proced-filter-alist'."
- :group 'proced
:type '(choice (symbol :tag "Filter Name")
(repeat :tag "Filters"
(choice (cons :tag "Key . Regexp" (symbol :tag "Key") regexp)
@@ -332,38 +323,32 @@ of `proced-filter-alist'."
It must be the KEY of an element of `proced-grammar-alist'.
It can also be a list of KEYs as in the SORT-SCHEMEs of the elements
of `proced-grammar-alist'."
- :group 'proced
:type '(choice (symbol :tag "Sort Scheme")
(repeat :tag "Key List" (symbol :tag "Key"))))
(make-variable-buffer-local 'proced-sort)
(defcustom proced-descend t
"Non-nil if proced listing is sorted in descending order."
- :group 'proced
:type '(boolean :tag "Descending Sort Order"))
(make-variable-buffer-local 'proced-descend)
(defcustom proced-goal-attribute 'args
"If non-nil, key of the attribute that defines the `goal-column'."
- :group 'proced
:type '(choice (const :tag "none" nil)
(symbol :tag "key")))
(defcustom proced-auto-update-interval 5
"Time interval in seconds for auto updating Proced buffers."
- :group 'proced
:type 'integer)
(defcustom proced-auto-update-flag nil
"Non-nil for auto update of a Proced buffer.
Can be changed interactively via `proced-toggle-auto-update'."
- :group 'proced
:type 'boolean)
(make-variable-buffer-local 'proced-auto-update-flag)
(defcustom proced-tree-flag nil
"Non-nil for display of Proced buffer as process tree."
- :group 'proced
:type 'boolean)
(make-variable-buffer-local 'proced-tree-flag)
@@ -371,26 +356,23 @@ Can be changed interactively via `proced-toggle-auto-update'."
"Normal hook run after displaying or updating a Proced buffer.
May be used to adapt the window size via `fit-window-to-buffer'."
:type 'hook
- :options '(fit-window-to-buffer)
- :group 'proced)
+ :options '(fit-window-to-buffer))
(defcustom proced-after-send-signal-hook nil
"Normal hook run after sending a signal to processes by `proced-send-signal'.
May be used to revert the process listing."
:type 'hook
- :options '(proced-revert)
- :group 'proced)
+ :options '(proced-revert))
;; Internal variables
(defvar proced-available (not (null (list-system-processes)))
"Non-nil means Proced is known to work on this system.")
-(defvar proced-process-alist nil
+(defvar-local proced-process-alist nil
"Alist of processes displayed by Proced.
The car of each element is the PID, and the cdr is a list of
cons pairs, see `proced-process-attributes'.")
-(make-variable-buffer-local 'proced-process-alist)
(defvar proced-sort-internal nil
"Sort scheme for listing (internal format).
@@ -408,26 +390,22 @@ It is a list of lists (KEY PREDICATE REVERSE).")
(defface proced-mark
'((t (:inherit font-lock-constant-face)))
- "Face used for Proced marks."
- :group 'proced-faces)
+ "Face used for Proced marks.")
(defface proced-marked
'((t (:inherit error)))
- "Face used for marked processes."
- :group 'proced-faces)
+ "Face used for marked processes.")
(defface proced-sort-header
'((t (:inherit font-lock-keyword-face)))
- "Face used for header of attribute used for sorting."
- :group 'proced-faces)
+ "Face used for header of attribute used for sorting.")
(defvar proced-re-mark "^[^ \n]"
"Regexp matching a marked line.
Important: the match ends just after the marker.")
-(defvar proced-header-line nil
+(defvar-local proced-header-line nil
"Headers in Proced buffer as a string.")
-(make-variable-buffer-local 'proced-header-line)
(defvar proced-temp-alist nil
"Temporary alist (internal variable).")
@@ -615,14 +593,23 @@ Important: the match ends just after the marker.")
(defun proced-header-line ()
"Return header line for Proced buffer."
- (list (propertize " "
- 'display
- (list 'space :align-to
- (line-number-display-width 'columns)))
- (if (<= (window-hscroll) (length proced-header-line))
- (replace-regexp-in-string ;; preserve text properties
- "\\(%\\)" "\\1\\1"
- (substring proced-header-line (window-hscroll))))))
+ (let ((base (line-number-display-width 'columns))
+ (hl (if (<= (window-hscroll) (length proced-header-line))
+ (substring proced-header-line (window-hscroll)))))
+ (when hl
+ ;; From buff-menu.el: Turn whitespace chars in the header into
+ ;; stretch specs so they work regardless of the header-line face.
+ (let ((pos 0))
+ (while (string-match "[ \t\n]+" hl pos)
+ (setq pos (match-end 0))
+ (put-text-property (match-beginning 0) pos 'display
+ `(space :align-to ,(+ pos base))
+ hl)))
+ (setq hl (replace-regexp-in-string ;; preserve text properties
+ "\\(%\\)" "\\1\\1"
+ hl)))
+ (list (propertize " " 'display `(space :align-to ,base))
+ hl)))
(defun proced-pid-at-point ()
"Return pid of system process at point.
@@ -676,8 +663,8 @@ After displaying or updating a Proced buffer, Proced runs the normal hook
(setq buffer-read-only t
truncate-lines t
header-line-format '(:eval (proced-header-line)))
- (add-hook 'post-command-hook 'force-mode-line-update nil t)
- (set (make-local-variable 'revert-buffer-function) 'proced-revert)
+ (add-hook 'post-command-hook #'force-mode-line-update nil t) ;; FIXME: Why?
+ (set (make-local-variable 'revert-buffer-function) #'proced-revert)
(set (make-local-variable 'font-lock-defaults)
'(proced-font-lock-keywords t nil nil beginning-of-line))
(if (and (not proced-auto-update-timer) proced-auto-update-interval)
@@ -940,11 +927,12 @@ Return the filtered process list."
(if (funcall (car filter) (cdr process))
(push process new-alist))))
(t ;; apply predicate to specified attribute
- (let ((fun (if (stringp (cdr filter))
- `(lambda (val)
- (string-match ,(cdr filter) val))
- (cdr filter)))
- value)
+ (let* ((cdrfilter (cdr filter))
+ (fun (if (stringp cdrfilter)
+ (lambda (val)
+ (string-match cdrfilter val))
+ cdrfilter))
+ value)
(dolist (process process-alist)
(setq value (cdr (assq (car filter) (cdr process))))
(if (and value (funcall fun value))
@@ -1023,7 +1011,7 @@ The list of children does not include grandchildren."
"Return list of children PIDs of PPID (including PPID)."
(let ((cpids (cdr (assq ppid proced-temp-alist))))
(if cpids
- (cons ppid (apply 'append (mapcar 'proced-children-pids cpids)))
+ (cons ppid (apply #'append (mapcar #'proced-children-pids cpids)))
(list ppid))))
(defun proced-process-tree (process-alist)
@@ -1114,7 +1102,7 @@ Return the rearranged process list."
proced-process-tree)
(if (cdr process-tree)
(let ((proced-tree-depth (1+ proced-tree-depth)))
- (mapc 'proced-tree-insert (cdr process-tree))))))
+ (mapc #'proced-tree-insert (cdr process-tree))))))
;; Refining
@@ -1207,7 +1195,7 @@ Return `equal' if T1 equals T2. Return nil otherwise."
;;; Sorting
-(define-obsolete-function-alias 'proced-xor 'xor "27.1")
+(define-obsolete-function-alias 'proced-xor #'xor "27.1")
(defun proced-sort-p (p1 p2)
"Predicate for sorting processes P1 and P2."
@@ -1436,10 +1424,11 @@ Replace newline characters by \"^J\" (two characters)."
;; Loop over all attributes
(while (setq grammar (assq (pop format) proced-grammar-alist))
(let* ((key (car grammar))
- (fun (cond ((stringp (nth 2 grammar))
- `(lambda (arg) (format ,(nth 2 grammar) arg)))
- ((not (nth 2 grammar)) 'identity)
- ( t (nth 2 grammar))))
+ (nth2grm (nth 2 grammar))
+ (fun (cond ((stringp nth2grm)
+ (lambda (arg) (format nth2grm arg)))
+ ((not nth2grm) #'identity)
+ (t nth2grm)))
(whitespace (if format whitespace ""))
;; Text properties:
;; We use the text property `proced-key' to store in each
@@ -1479,13 +1468,13 @@ Replace newline characters by \"^J\" (two characters)."
(end-of-line)
(setq value (cdr (assq key (cdr process))))
(insert (if value
- (apply 'propertize (funcall fun value) fprops)
+ (apply #'propertize (funcall fun value) fprops)
(format (concat "%" (number-to-string (nth 3 grammar)) "s")
unknown))
whitespace)
(forward-line))
(push (format (concat "%" (number-to-string (nth 3 grammar)) "s")
- (apply 'propertize (nth 1 grammar) hprops))
+ (apply #'propertize (nth 1 grammar) hprops))
header-list))
( ;; last field left-justified
@@ -1493,10 +1482,10 @@ Replace newline characters by \"^J\" (two characters)."
(dolist (process process-alist)
(end-of-line)
(setq value (cdr (assq key (cdr process))))
- (insert (if value (apply 'propertize (funcall fun value) fprops)
+ (insert (if value (apply #'propertize (funcall fun value) fprops)
unknown))
(forward-line))
- (push (apply 'propertize (nth 1 grammar) hprops) header-list))
+ (push (apply #'propertize (nth 1 grammar) hprops) header-list))
(t ;; calculated field width
(let ((width (length (nth 1 grammar)))
@@ -1504,14 +1493,14 @@ Replace newline characters by \"^J\" (two characters)."
(dolist (process process-alist)
(setq value (cdr (assq key (cdr process))))
(if value
- (setq value (apply 'propertize (funcall fun value) fprops)
+ (setq value (apply #'propertize (funcall fun value) fprops)
width (max width (length value))
field-list (cons value field-list))
(push unknown field-list)
(setq width (max width (length unknown)))))
(let ((afmt (concat "%" (if (eq 'left (nth 3 grammar)) "-" "")
(number-to-string width) "s")))
- (push (format afmt (apply 'propertize (nth 1 grammar) hprops))
+ (push (format afmt (apply #'propertize (nth 1 grammar) hprops))
header-list)
(dolist (value (nreverse field-list))
(end-of-line)
@@ -1527,7 +1516,7 @@ Replace newline characters by \"^J\" (two characters)."
(forward-line))
;; Set header line
(setq proced-header-line
- (mapconcat 'identity (nreverse header-list) whitespace))
+ (mapconcat #'identity (nreverse header-list) whitespace))
(if (string-match "[ \t]+$" proced-header-line)
(setq proced-header-line (substring proced-header-line 0
(match-beginning 0))))
@@ -1742,7 +1731,7 @@ The value returned is the value of the last form in BODY."
(setq truncate-lines t
proced-header-line header-line ; inherit header line
header-line-format '(:eval (proced-header-line)))
- (add-hook 'post-command-hook 'force-mode-line-update nil t)
+ (add-hook 'post-command-hook #'force-mode-line-update nil t) ;FIXME: Why?
(let ((inhibit-read-only t))
(erase-buffer)
(buffer-disable-undo)
@@ -1780,8 +1769,8 @@ supported but discouraged. It will be removed in a future version of Emacs."
(format "%d processes" (length process-alist))))
(completion-ignore-case t)
(completion-extra-properties
- '(:annotation-function
- (lambda (s) (cdr (assoc s proced-signal-list))))))
+ `(:annotation-function
+ ,(lambda (s) (cdr (assoc s proced-signal-list))))))
(proced-with-processes-buffer process-alist
(list (completing-read (concat "Send signal [" pnum
"] (default TERM): ")
@@ -1805,8 +1794,8 @@ supported but discouraged. It will be removed in a future version of Emacs."
(format "%d processes" (length process-alist))))
(completion-ignore-case t)
(completion-extra-properties
- '(:annotation-function
- (lambda (s) (cdr (assoc s proced-signal-list))))))
+ `(:annotation-function
+ ,(lambda (s) (cdr (assoc s proced-signal-list))))))
(proced-with-processes-buffer process-alist
(setq signal (completing-read (concat "Send signal [" pnum
"] (default TERM): ")
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 3243e6432f2..bf8aacccc37 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -305,7 +305,7 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
(let ((fun-map (make-hash-table :test 'profiler-function-equal))
(parent-map (make-hash-table :test 'eq))
(leftover-tree (profiler-make-calltree
- :entry (intern "...") :parent tree)))
+ :entry '... :parent tree)))
(push leftover-tree (profiler-calltree-children tree))
(maphash
(lambda (backtrace _count)
@@ -816,7 +816,7 @@ If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
(interactive
(list (if (not (fboundp 'profiler-cpu-start)) 'mem
- (intern (completing-read "Mode (default cpu): "
+ (intern (completing-read (format-prompt "Mode" "cpu")
'("cpu" "mem" "cpu+mem")
nil t nil nil "cpu")))))
(cl-ecase mode
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index e63e4d65fb5..9dacd5856cf 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -52,7 +52,7 @@
;;
;; * Probably. Show rules/dependencies for ANT like for Makefile (does ANT
;; support vocabularies and grammar inheritance?), I have to look at
-;; jde-ant.el: http://jakarta.apache.org/ant/manual/OptionalTasks/antlr.html
+;; jde-ant.el: https://jakarta.apache.org/ant/manual/OptionalTasks/antlr.html
;; * Probably. Make `indent-region' faster, especially in actions. ELP
;; profiling in a class init action shows half the time is spent in
;; `antlr-next-rule', the other half in `c-guess-basic-syntax'.
@@ -695,7 +695,7 @@ imenu."
(define-key map "\e\C-e" 'antlr-end-of-rule)
(define-key map "\C-c\C-a" 'antlr-beginning-of-body)
(define-key map "\C-c\C-e" 'antlr-end-of-body)
- (define-key map "\C-c\C-f" 'c-forward-into-nomenclature)
+ (define-key map "\C-c\C-f" 'subword-forward)
(define-key map "\C-c\C-b" 'c-backward-into-nomenclature)
(define-key map "\C-c\C-c" 'comment-region)
(define-key map "\C-c\C-v" 'antlr-hide-actions)
@@ -720,9 +720,8 @@ imenu."
"Major mode menu."
`("Antlr"
,@(if (cond-emacs-xemacs
- :EMACS (and antlr-options-use-submenus
- (>= emacs-major-version 21))
- :XEMACS antlr-options-use-submenus)
+ :EMACS antlr-options-use-submenus
+ :XEMACS antlr-options-use-submenus)
`(("Insert File Option"
:filter ,(lambda (x) (antlr-options-menu-filter 1 x)))
("Insert Grammar Option"
@@ -745,7 +744,7 @@ imenu."
["Backward Statement" c-beginning-of-statement t]
["Forward Statement" c-end-of-statement t]
["Backward Into Nomencl." c-backward-into-nomenclature t]
- ["Forward Into Nomencl." c-forward-into-nomenclature t])
+ ["Forward Into Nomencl." subword-forward t])
["Indent Region" indent-region
:active (and (not buffer-read-only) (c-region-is-active-p))]
["Comment Out Region" comment-region
diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el
index 5d5811b47d1..d12bed7e27d 100644
--- a/lisp/progmodes/autoconf.el
+++ b/lisp/progmodes/autoconf.el
@@ -1,4 +1,4 @@
-;;; autoconf.el --- mode for editing Autoconf configure.ac files
+;;; autoconf.el --- mode for editing Autoconf configure.ac files -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 87e88163ac7..98e58be2303 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -42,7 +42,7 @@
;; See documentation of function `bat-mode'.
;;
;; Separate package `dos-indent' (Matthew Fidler) provides rudimentary
-;; indentation, see http://www.emacswiki.org/emacs/dos-indent.el.
+;; indentation, see https://www.emacswiki.org/emacs/dos-indent.el.
;;
;; Acknowledgements:
;;
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 75ebc29710c..c52331f84fa 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -72,7 +72,7 @@ so that it is considered safe, see `enable-local-variables'.")
"\\([Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
"Regular expression matching bug references.
The second subexpression should match the bug reference (usually a number)."
- :type 'string
+ :type 'regexp
:version "24.3" ; previously defconst
:group 'bug-reference)
@@ -139,12 +139,312 @@ The second subexpression should match the bug reference (usually a number)."
(when url
(browse-url url))))))
+(defun bug-reference--maybe-setup-from-vc (url url-rx bug-rx bug-url-fmt)
+ (when (string-match url-rx url)
+ (setq-local bug-reference-bug-regexp bug-rx)
+ (setq-local bug-reference-url-format
+ (let (groups)
+ (dotimes (i (/ (length (match-data)) 2))
+ (push (match-string i url) groups))
+ (funcall bug-url-fmt (nreverse groups))))))
+
+(defvar bug-reference-setup-from-vc-alist
+ `(;;
+ ;; GNU projects on savannah.
+ ;;
+ ;; Not all of them use debbugs but that doesn't really matter
+ ;; because the auto-setup is only performed if
+ ;; `bug-reference-url-format' and `bug-reference-bug-regexp'
+ ;; aren't set already.
+ ("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:"
+ "\\<\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\>"
+ ,(lambda (_) "https://debbugs.gnu.org/%s"))
+ ;;
+ ;; GitHub projects.
+ ;;
+ ;; Here #17 may refer to either an issue or a pull request but
+ ;; visiting the issue/17 web page will automatically redirect to
+ ;; the pull/17 page if 17 is a PR. Explicit user/project#17 links
+ ;; to possibly different projects are also supported.
+ ("[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
+ "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
+ ,(lambda (groups)
+ (let ((ns-project (nth 1 groups)))
+ (lambda ()
+ (concat "https://github.com/"
+ (or
+ ;; Explicit user/proj#18 link.
+ (match-string 1)
+ ns-project)
+ "/issues/"
+ (match-string 2))))))
+ ;;
+ ;; GitLab projects.
+ ;;
+ ;; Here #18 is an issue and !17 is a merge request. Explicit
+ ;; namespace/project#18 or namespace/project!17 references to
+ ;; possibly different projects are also supported.
+ ("[/@]gitlab.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
+ "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:[#!]\\)\\(?2:[0-9]+\\)\\>"
+ ,(lambda (groups)
+ (let ((ns-project (nth 1 groups)))
+ (lambda ()
+ (concat "https://gitlab.com/"
+ (or (match-string 1)
+ ns-project)
+ "/-/"
+ (if (string= (match-string 3) "#")
+ "issues/"
+ "merge_requests/")
+ (match-string 2)))))))
+ "An alist for setting up `bug-reference-mode' based on VC URL.
+
+Each element has the form (URL-REGEXP BUG-REGEXP URL-FORMAT-FN).
+
+URL-REGEXP is matched against the version control URL of the
+current buffer's file. If it matches, BUG-REGEXP is set as
+`bug-reference-bug-regexp'. URL-FORMAT-FN is a function of one
+argument that receives a list of the groups 0 to N of matching
+URL-REGEXP against the VCS URL and returns the value to be set as
+`bug-reference-url-format'.")
+
+(defun bug-reference-try-setup-from-vc ()
+ "Try setting up `bug-reference-mode' based on VC information.
+Test each configuration in `bug-reference-setup-from-vc-alist'
+and apply it if applicable."
+ (let ((file-or-dir (or buffer-file-name
+ ;; Catches modes such as vc-dir and Magit.
+ default-directory)))
+ (when file-or-dir
+ (let* ((backend (vc-responsible-backend file-or-dir t))
+ (url
+ (or (ignore-errors
+ (vc-call-backend backend 'repository-url "upstream"))
+ (ignore-errors
+ (vc-call-backend backend 'repository-url)))))
+ (when url
+ (catch 'found
+ (dolist (config bug-reference-setup-from-vc-alist)
+ (when (apply #'bug-reference--maybe-setup-from-vc
+ url config)
+ (throw 'found t)))))))))
+
+(defvar bug-reference-setup-from-mail-alist
+ `((,(regexp-opt '("emacs" "auctex" "gnus" "tramp" "orgmode") 'words)
+ ,(regexp-opt '("@debbugs.gnu.org" "-devel@gnu.org"
+ ;; List-Id of Gnus devel mailing list.
+ "ding.gnus.org"))
+ "\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
+ "https://debbugs.gnu.org/%s"))
+ "An alist for setting up `bug-reference-mode' in mail modes.
+
+This takes action if `bug-reference-mode' is enabled in group and
+message buffers of Emacs mail clients. Currently, only Gnus is
+supported.
+
+Each element has the form
+
+ (GROUP-REGEXP HEADER-REGEXP BUG-REGEXP URL-FORMAT)
+
+GROUP-REGEXP is a regexp matched against the current mail folder
+or newsgroup name. HEADER-REGEXP is a regexp matched against the
+From, To, Cc, Newsgroup, and List-ID header values of the current
+mail or newsgroup message. If any of those matches, BUG-REGEXP
+is set as `bug-reference-bug-regexp' and URL-FORMAT is set as
+`bug-reference-url-format'.
+
+Note: In Gnus, if a summary buffer has been set up based on
+GROUP-REGEXP, all article buffers opened from there will get the
+same `bug-reference-url-format' and `bug-reference-url-format'.")
+
+(defvar gnus-newsgroup-name)
+
+(defun bug-reference--maybe-setup-from-mail (group header-values)
+ "Set up according to mail GROUP or HEADER-VALUES.
+Group is a mail group/folder name and HEADER-VALUES is a list of
+mail header values, e.g., the values of From, To, Cc, List-ID,
+and Newsgroup.
+
+If any GROUP-REGEXP or HEADER-REGEXP of
+`bug-reference-setup-from-mail-alist' matches GROUP or any
+element in HEADER-VALUES, the corresponding BUG-REGEXP and
+URL-FORMAT are set."
+ (catch 'setup-done
+ (dolist (config bug-reference-setup-from-mail-alist)
+ (when (or
+ (and group
+ (car config)
+ (string-match-p (car config) group))
+ (and header-values
+ (nth 1 config)
+ (catch 'matching-header
+ (dolist (h header-values)
+ (when (and h (string-match-p (nth 1 config) h))
+ (throw 'matching-header t))))))
+ (setq-local bug-reference-bug-regexp (nth 2 config))
+ (setq-local bug-reference-url-format (nth 3 config))
+ (throw 'setup-done t)))))
+
+(defun bug-reference-try-setup-from-gnus ()
+ "Try setting up `bug-reference-mode' based on Gnus group or article.
+Test each configuration in `bug-reference-setup-from-mail-alist'
+and set it if applicable."
+ (when (and (derived-mode-p 'gnus-summary-mode)
+ (bound-and-true-p gnus-newsgroup-name))
+ ;; Gnus reuses its article buffer so we have to check whenever the
+ ;; article changes.
+ (add-hook 'gnus-article-prepare-hook
+ #'bug-reference--try-setup-gnus-article)
+ (bug-reference--maybe-setup-from-mail gnus-newsgroup-name nil)))
+
+(defvar gnus-article-buffer)
+(defvar gnus-original-article-buffer)
+(defvar gnus-summary-buffer)
+
+(defun bug-reference--try-setup-gnus-article ()
+ (with-demoted-errors
+ "Error in bug-reference--try-setup-gnus-article: %S"
+ (when (and bug-reference-mode ;; Only if enabled in article buffers.
+ (derived-mode-p
+ 'gnus-article-mode
+ ;; Apparently, gnus-article-prepare-hook is run in the
+ ;; summary buffer...
+ 'gnus-summary-mode)
+ gnus-article-buffer
+ gnus-original-article-buffer
+ (buffer-live-p (get-buffer gnus-article-buffer))
+ (buffer-live-p (get-buffer gnus-original-article-buffer)))
+ (with-current-buffer gnus-article-buffer
+ (catch 'setup-done
+ ;; Copy over the values from the summary buffer.
+ (when (and gnus-summary-buffer
+ (buffer-live-p gnus-summary-buffer))
+ (setq-local bug-reference-bug-regexp
+ (with-current-buffer gnus-summary-buffer
+ bug-reference-bug-regexp))
+ (setq-local bug-reference-url-format
+ (with-current-buffer gnus-summary-buffer
+ bug-reference-url-format))
+ (when (and bug-reference-bug-regexp
+ bug-reference-url-format)
+ (throw 'setup-done t)))
+ ;; If the summary had no values, try setting according to
+ ;; the values of the From, To, and Cc headers.
+ (let (header-values)
+ (with-current-buffer
+ (get-buffer gnus-original-article-buffer)
+ (save-excursion
+ (goto-char (point-min))
+ ;; The Newsgroup is omitted because we already matched
+ ;; based on group name in the summary buffer.
+ (dolist (field '("list-id" "to" "from" "cc"))
+ (let ((val (mail-fetch-field field)))
+ (when val
+ (push val header-values))))))
+ (bug-reference--maybe-setup-from-mail nil header-values)))))))
+
+(defvar bug-reference-setup-from-irc-alist
+ `((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc"
+ "erc") 'words))
+ "freenode"
+ "\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
+ "https://debbugs.gnu.org/%s"))
+ "An alist for setting up `bug-reference-mode' in IRC modes.
+
+This takes action if `bug-reference-mode' is enabled in IRC
+channels using one of Emacs' IRC clients (rcirc and ERC).
+Currently, rcirc and ERC are supported.
+
+Each element has the form
+
+ (CHANNEL-REGEXP NETWORK-REGEXP BUG-REGEXP URL-FORMAT)
+
+CHANNEL-REGEXP is a regexp matched against the current IRC
+channel name (e.g. #emacs). NETWORK-REGEXP is matched against
+the IRC network name (e.g. freenode). Both entries are optional.
+If all given entries match, BUG-REGEXP is set as
+`bug-reference-bug-regexp' and URL-FORMAT is set as
+`bug-reference-url-format'.")
+
+(defun bug-reference--maybe-setup-from-irc (channel network)
+ "Set up according to IRC CHANNEL or NETWORK.
+CHANNEL is an IRC channel name (or generally a target, i.e., it
+could also be a user name) and NETWORK is that channel's network
+name.
+
+If any `bug-reference-setup-from-irc-alist' entry's
+CHANNEL-REGEXP and NETWORK-REGEXP match CHANNEL and NETWORK, the
+corresponding BUG-REGEXP and URL-FORMAT are set."
+ (catch 'setup-done
+ (dolist (config bug-reference-setup-from-irc-alist)
+ (let ((channel-rx (car config))
+ (network-rx (nth 1 config)))
+ (when (and
+ ;; One of both has to be given.
+ (or channel-rx network-rx)
+ ;; The args have to be set.
+ channel network)
+ (when (and
+ (or (null channel-rx)
+ (string-match-p channel-rx channel))
+ (or (null network-rx)
+ (string-match-p network-rx network)))
+ (setq-local bug-reference-bug-regexp (nth 2 config))
+ (setq-local bug-reference-url-format (nth 3 config))
+ (throw 'setup-done t)))))))
+
+(defvar rcirc-target)
+(defvar rcirc-server-buffer)
+(defvar rcirc-server)
+
+(defun bug-reference-try-setup-from-rcirc ()
+ "Try setting up `bug-reference-mode' based on rcirc channel and server.
+Test each configuration in `bug-reference-setup-from-irc-alist'
+and set it if applicable."
+ (when (derived-mode-p 'rcirc-mode)
+ (bug-reference--maybe-setup-from-irc
+ rcirc-target
+ (and rcirc-server-buffer
+ (buffer-live-p rcirc-server-buffer)
+ (with-current-buffer rcirc-server-buffer
+ rcirc-server)))))
+
+(declare-function erc-format-target "erc")
+(declare-function erc-network-name "erc-networks")
+
+(defun bug-reference-try-setup-from-erc ()
+ "Try setting up `bug-reference-mode' based on ERC channel and server.
+Test each configuration in `bug-reference-setup-from-irc-alist'
+and set it if applicable."
+ (when (derived-mode-p 'erc-mode)
+ (bug-reference--maybe-setup-from-irc
+ (erc-format-target)
+ (erc-network-name))))
+
+(defun bug-reference--run-auto-setup ()
+ (when (or bug-reference-mode
+ bug-reference-prog-mode)
+ ;; Automatic setup only if the variables aren't already set, e.g.,
+ ;; by a local variables section in the file.
+ (unless (and bug-reference-bug-regexp
+ bug-reference-url-format)
+ (with-demoted-errors
+ "Error during bug-reference auto-setup: %S"
+ (catch 'setup
+ (dolist (f (list #'bug-reference-try-setup-from-vc
+ #'bug-reference-try-setup-from-gnus
+ #'bug-reference-try-setup-from-rcirc
+ #'bug-reference-try-setup-from-erc))
+ (when (funcall f)
+ (throw 'setup t))))))))
+
;;;###autoload
(define-minor-mode bug-reference-mode
"Toggle hyperlinking bug references in the buffer (Bug Reference mode)."
nil
""
nil
+ :after-hook (bug-reference--run-auto-setup)
(if bug-reference-mode
(jit-lock-register #'bug-reference-fontify)
(jit-lock-unregister #'bug-reference-fontify)
@@ -158,6 +458,7 @@ The second subexpression should match the bug reference (usually a number)."
nil
""
nil
+ :after-hook (bug-reference--run-auto-setup)
(if bug-reference-prog-mode
(jit-lock-register #'bug-reference-fontify)
(jit-lock-unregister #'bug-reference-fontify)
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index f30477dc787..7884d4bd2ec 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -790,6 +790,38 @@ arglist-cont-nonempty."
(or (c-lineup-assignments langelem)
c-basic-offset))
+(defun c-lineup-ternary-bodies (langelem)
+ "Line up true and false branches of a ternary operator (i.e. `?:').
+More precisely, if the line starts with a colon which is a part of
+a said operator, align it with corresponding question mark; otherwise
+return nil. For example:
+
+ return arg % 2 == 0 ? arg / 2
+ : (3 * arg + 1); <- c-lineup-ternary-bodies
+
+Works with: arglist-cont, arglist-cont-nonempty and statement-cont."
+ (save-excursion
+ (back-to-indentation)
+ (when (and (eq ?: (char-after))
+ (not (eq ?: (char-after (1+ (point))))))
+ (let ((limit (c-langelem-pos langelem)) (depth 1))
+ (catch 'done
+ (while (and (c-syntactic-skip-backward "^?:" limit t)
+ (not (bobp)))
+ (backward-char)
+ (cond ((eq (char-after) ??)
+ ;; If we've found a question mark, decrease depth. If we've
+ ;; reached zero, we've found the one we were looking for.
+ (when (zerop (setq depth (1- depth)))
+ (throw 'done (vector (current-column)))))
+ ((or (eq ?: (char-before)) (eq ?? (char-before)))
+ ;; Step over `::' and `?:' operators. We don't have to
+ ;; handle `?:' here but doing so saves an iteration.
+ (if (eq (point) limit)
+ (throw 'done nil)
+ (goto-char (1- (point)))))
+ ((setq depth (1+ depth)))))))))) ; Otherwise increase depth.
+
(defun c-lineup-cascaded-calls (langelem)
"Line up \"cascaded calls\" under each other.
If the line begins with \"->\" or \".\" and the preceding line ends
@@ -1083,7 +1115,7 @@ arglist-cont."
(vector (+ (current-column) c-basic-offset))))
(vector 0)))))
-(defun c-lineup-2nd-brace-entry-in-arglist (langelem)
+(defun c-lineup-2nd-brace-entry-in-arglist (_langelem)
"Lineup the second entry of a brace block under the first, when the first
line is also contained in an arglist or an enclosing brace ON THAT LINE.
@@ -1124,7 +1156,7 @@ Works with brace-list-intro."
(eq (char-after) ?{))))
'c-lineup-arglist-intro-after-paren))
-(defun c-lineup-class-decl-init-+ (langelem)
+(defun c-lineup-class-decl-init-+ (_langelem)
"Line up the second entry of a class (etc.) initializer c-basic-offset
characters in from the identifier when:
\(i) The type is a class, struct, union, etc. (but not an enum);
@@ -1165,7 +1197,7 @@ Works with: brace-list-intro."
(eq (point) init-pos)
(vector (+ (current-column) c-basic-offset)))))))
-(defun c-lineup-class-decl-init-after-brace (langelem)
+(defun c-lineup-class-decl-init-after-brace (_langelem)
"Line up the second entry of a class (etc.) initializer after its opening
brace when:
\(i) The type is a class, struct, union, etc. (but not an enum);
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index fd61e3e3287..52e6da6f4ac 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -1003,7 +1003,7 @@ std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\
;; Matches an unterminated string/regexp, NOT including the eol at the end.
(defconst c-awk-harmless-pattern-characters*
- (concat "\\([^{;#/\"\\\\\n\r]\\|" c-awk-esc-pair-re "\\)*"))
+ (concat "\\([^{;#/\"\\\n\r]\\|" c-awk-esc-pair-re "\\)*"))
;; Matches any "harmless" character in a pattern or an escaped character pair.
(defun c-awk-at-statement-end-p ()
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 1071191775b..0ce3b3f6edd 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -48,6 +48,7 @@
(cc-bytecomp-defvar filladapt-mode) ; c-fill-paragraph contains a kludge
; which looks at this.
(cc-bytecomp-defun electric-pair-post-self-insert-function)
+(cc-bytecomp-defvar c-indent-to-body-directives)
;; Indentation / Display syntax functions
(defvar c-fix-backslashes t)
@@ -512,11 +513,11 @@ function to control that."
(let ((src (default-value 'post-self-insert-hook)))
(while src
(unless (memq (car src) c--unsafe-post-self-insert-hook-functions)
- (add-hook 'dest (car src) t)) ; Preserve the order of the functions.
+ (push (car src) dest))
(setq src (cdr src)))))
- (t (add-hook 'dest (car src) t))) ; Preserve the order of the functions.
+ (t (push (car src) dest)))
(setq src (cdr src)))
- (run-hooks 'dest)))
+ (mapc #'funcall (nreverse dest)))) ; Preserve the order of the functions.
(defmacro c--call-post-self-insert-hook-more-safely ()
;; Call post-self-insert-hook, if such exists. See comment for
@@ -906,7 +907,6 @@ settings of `c-cleanup-list' are done."
(when (and (boundp 'electric-pair-mode)
electric-pair-mode)
(let ((size (buffer-size))
- (c-in-electric-pair-functionality t)
post-self-insert-hook)
(electric-pair-post-self-insert-function)
(setq got-pair-} (and at-eol
@@ -1441,6 +1441,98 @@ keyword on the line, the keyword is not inserted inside a literal, and
(indent-according-to-mode)
(delete-char -2)))))
+(defun c-align-cpp-indent-to-body ()
+ "Align a \"#pragma\" line under the previous line.
+This function is intented for use as a member of `c-special-indent-hook'."
+ (when (assq 'cpp-macro c-syntactic-context)
+ (when
+ (save-excursion
+ (save-match-data
+ (back-to-indentation)
+ (and
+ (looking-at (concat c-opt-cpp-symbol "[ \t]*\\([a-zA-Z0-9_]+\\)"))
+ (member (match-string-no-properties 1)
+ c-cpp-indent-to-body-directives))))
+ (c-indent-line (delete '(cpp-macro) c-syntactic-context)))))
+
+(defvar c-cpp-indent-to-body-flag nil)
+;; Non-nil when CPP directives such as "#pragma" should be indented to under
+;; the preceding statement.
+(make-variable-buffer-local 'c-cpp-indent-to-body-flag)
+
+(defun c-electric-pragma ()
+ "Reindent the current line if appropriate.
+
+This function is used to reindent a preprocessor line when the
+symbol for the directive, typically \"pragma\", triggers this
+function as a hook function of an abbreviation.
+
+The \"#\" of the preprocessor construct is aligned under the
+first anchor point of the line's syntactic context.
+
+The line is reindented if the construct is not in a string or
+comment, there is exactly one \"#\" contained in optional
+whitespace before it on the current line, and `c-electric-flag'
+and `c-syntactic-indentation' are both non-nil."
+ (save-excursion
+ (save-match-data
+ (when
+ (and
+ c-cpp-indent-to-body-flag
+ c-electric-flag
+ c-syntactic-indentation
+ last-abbrev-location
+ c-opt-cpp-symbol ; "#" or nil.
+ (progn (back-to-indentation)
+ (looking-at (concat c-opt-cpp-symbol "[ \t]*")))
+ (>= (match-end 0) last-abbrev-location)
+ (not (c-literal-limits)))
+ (c-indent-line (delete '(cpp-macro) (c-guess-basic-syntax)))))))
+
+(defun c-add-indent-to-body-to-abbrev-table (d)
+ ;; Create an abbreviation table entry for the directive D, and add it to the
+ ;; current abbreviation table. Existing abbreviation (e.g. for "else") do
+ ;; not get overwritten.
+ (when (and c-buffer-is-cc-mode
+ local-abbrev-table
+ (not (abbrev-symbol d local-abbrev-table)))
+ (condition-case nil
+ (define-abbrev local-abbrev-table d d 'c-electric-pragma 0 t)
+ (wrong-number-of-arguments
+ (define-abbrev local-abbrev-table d d 'c-electric-pragma)))))
+
+(defun c-clear-stale-indent-to-body-abbrevs ()
+ ;; Fill in this comment. FIXME!!!
+ (when (fboundp 'abbrev-get)
+ (mapatoms (lambda (a)
+ (when (and (abbrev-get a ':system) ; Preserve a user's abbrev!
+ (not (member (symbol-name a) c-std-abbrev-keywords))
+ (not (member (symbol-name a)
+ c-cpp-indent-to-body-directives)))
+ (unintern a local-abbrev-table)))
+ local-abbrev-table)))
+
+(defun c-toggle-cpp-indent-to-body (&optional arg)
+ "Toggle the C preprocessor indent-to-body feature.
+When enabled, preprocessor directives which are words in
+`c-indent-to-body-directives' are indented as if they were statements.
+
+Optional numeric ARG, if supplied, turns on the feature when positive,
+turns it off when negative, and just toggles it when zero or
+left out."
+ (interactive "P")
+ (setq c-cpp-indent-to-body-flag
+ (c-calculate-state arg c-cpp-indent-to-body-flag))
+ (if c-cpp-indent-to-body-flag
+ (progn
+ (c-clear-stale-indent-to-body-abbrevs)
+ (mapc 'c-add-indent-to-body-to-abbrev-table
+ c-cpp-indent-to-body-directives)
+ (add-hook 'c-special-indent-hook 'c-align-cpp-indent-to-body nil t))
+ (remove-hook 'c-special-indent-hook 'c-align-cpp-indent-to-body t))
+ (message "c-cpp-indent-to-body %sabled"
+ (if c-cpp-indent-to-body-flag "en" "dis")))
+
(declare-function subword-forward "subword" (&optional arg))
@@ -1461,19 +1553,6 @@ keyword on the line, the keyword is not inserted inside a literal, and
(declare-function c-backward-subword "ext:cc-subword" (&optional arg))
;; "nomenclature" functions + c-scope-operator.
-(defun c-forward-into-nomenclature (&optional arg)
- "Compatibility alias for `c-forward-subword'."
- (interactive "p")
- (if (fboundp 'subword-mode)
- (progn
- (require 'subword)
- (subword-forward arg))
- (require 'cc-subword)
- (c-forward-subword arg)))
-(make-obsolete 'c-forward-into-nomenclature
- (if (fboundp 'subword-mode) 'subword-forward 'c-forward-subword)
- "23.2")
-
(defun c-backward-into-nomenclature (&optional arg)
"Compatibility alias for `c-backward-subword'."
(interactive "p")
@@ -2024,6 +2103,23 @@ other top level construct with a brace block."
(c-backward-syntactic-ws)
(point))))
+ ((and (c-major-mode-is 'objc-mode) (looking-at "[-+]\\s-*(")) ; Objective-C method
+ ;; Move to the beginning of the method name.
+ (c-forward-token-2 2 t)
+ (let* ((class
+ (save-excursion
+ (when (re-search-backward
+ "^\\s-*@\\(implementation\\|class\\|interface\\)\\s-+\\(\\sw+\\)" nil t)
+ (match-string-no-properties 2))))
+ (limit (save-excursion (re-search-forward "[;{]" nil t)))
+ (method (when (re-search-forward "\\(\\sw+:?\\)" limit t)
+ (match-string-no-properties 1))))
+ (when (and class method)
+ ;; Add the parameter labels onto name. They always end in ':'.
+ (while (re-search-forward "\\(\\sw+:\\)" limit 1)
+ (setq method (concat method (match-string-no-properties 1))))
+ (concat "[" class " " method "]"))))
+
(t ; Normal function or initializer.
(when (looking-at c-defun-type-name-decl-key) ; struct, etc.
(goto-char (match-end 0))
@@ -2230,7 +2326,7 @@ with a brace block, at the outermost level of nesting."
(c-save-buffer-state ((paren-state (c-parse-state))
(orig-point-min (point-min))
(orig-point-max (point-max))
- lim name where limits fdoc)
+ lim name limits where)
(setq lim (c-widen-to-enclosing-decl-scope
paren-state orig-point-min orig-point-max))
(and lim (setq lim (1- lim)))
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index a1e3a236a11..c82b3a34e33 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -87,7 +87,7 @@
;;; Variables also used at compile time.
-(defconst c-version "5.34.1"
+(defconst c-version "5.34.2"
"CC Mode version number.")
(defconst c-version-sym (intern c-version))
@@ -434,6 +434,14 @@ to it is returned. This function does not modify the point or the mark."
(setq count (+ count (skip-chars-backward "\\\\"))))
(not (zerop (logand count 1))))))
+(defmacro c-will-be-unescaped (beg)
+ ;; Would the character after BEG be unescaped?
+ `(save-excursion
+ (let (count)
+ (goto-char ,beg)
+ (setq count (skip-chars-backward "\\\\"))
+ (zerop (logand count 1)))))
+
(defvar c-use-extents)
(defmacro c-next-single-property-change (position prop &optional object limit)
@@ -445,6 +453,15 @@ to it is returned. This function does not modify the point or the mark."
;; Emacs and earlier XEmacs
`(next-single-property-change ,position ,prop ,object ,limit)))
+(defmacro c-previous-single-property-change (position prop &optional object limit)
+ ;; See the doc string for either of the defuns expanded to.
+ (if (and c-use-extents
+ (fboundp 'previous-single-char-property-change))
+ ;; XEmacs >= 2005-01-25
+ `(previous-single-char-property-change ,position ,prop ,object ,limit)
+ ;; Emacs and earlier XEmacs
+ `(previous-single-property-change ,position ,prop ,object ,limit)))
+
(defmacro c-region-is-active-p ()
;; Return t when the region is active. The determination of region
;; activeness is different in both Emacs and XEmacs.
@@ -1047,15 +1064,6 @@ MODE is either a mode symbol or a list of mode symbols."
;; properties set on a single character and that never spread to any
;; other characters.
-(defmacro c-put-syn-tab (pos value)
- ;; Set both the syntax-table and the c-fl-syn-tab text properties at POS to
- ;; VALUE (which should not be nil).
- `(let ((-pos- ,pos)
- (-value- ,value))
- (c-put-char-property -pos- 'syntax-table -value-)
- (c-put-char-property -pos- 'c-fl-syn-tab -value-)
- (c-truncate-lit-pos-cache -pos-)))
-
(eval-and-compile
;; Constant used at compile time to decide whether or not to use
;; XEmacs extents. Check all the extent functions we'll use since
@@ -1183,13 +1191,6 @@ MODE is either a mode symbol or a list of mode symbols."
;; Emacs < 21.
`(c-clear-char-property-fun ,pos ',property))))
-(defmacro c-clear-syn-tab (pos)
- ;; Remove both the 'syntax-table and `c-fl-syn-tab properties at POS.
- `(let ((-pos- ,pos))
- (c-clear-char-property -pos- 'syntax-table)
- (c-clear-char-property -pos- 'c-fl-syn-tab)
- (c-truncate-lit-pos-cache -pos-)))
-
(defmacro c-min-property-position (from to property)
;; Return the first position in the range [FROM to) where the text property
;; PROPERTY is set, or `most-positive-fixnum' if there is no such position.
@@ -1235,8 +1236,18 @@ MODE is either a mode symbol or a list of mode symbols."
;; Remove all occurrences of the `syntax-table' and `c-fl-syn-tab' text
;; properties between FROM and TO.
`(let ((-from- ,from) (-to- ,to))
- (c-clear-char-properties -from- -to- 'syntax-table)
- (c-clear-char-properties -from- -to- 'c-fl-syn-tab)))
+ (when (and
+ c-min-syn-tab-mkr c-max-syn-tab-mkr
+ (< -from- c-max-syn-tab-mkr)
+ (> -to- c-min-syn-tab-mkr))
+ (let ((pos -from-))
+ (while (and
+ (< pos -to-)
+ (setq pos (c-min-property-position pos -to- 'c-fl-syn-tab))
+ (< pos -to-))
+ (c-clear-syn-tab pos)
+ (setq pos (1+ pos)))))
+ (c-clear-char-properties -from- -to- 'syntax-table)))
(defmacro c-search-forward-char-property (property value &optional limit)
"Search forward for a text-property PROPERTY having value VALUE.
@@ -1456,28 +1467,6 @@ with value CHAR in the region [FROM to)."
(c-put-char-property (point) ,property ,value)
(forward-char)))))
-(defmacro c-with-extended-string-fences (beg end &rest body)
- ;; If needed, extend the region with "mirrored" c-fl-syn-tab properties to
- ;; contain the region (BEG END), then evaluate BODY. If this mirrored
- ;; region was initially empty, restore it afterwards.
- `(let ((-beg- ,beg)
- (-end- ,end)
- )
- (cond
- ((null c-fl-syn-tab-region)
- (unwind-protect
- (progn
- (c-restore-string-fences -beg- -end-)
- ,@body)
- (c-clear-string-fences)))
- ((and (>= -beg- (car c-fl-syn-tab-region))
- (<= -end- (cdr c-fl-syn-tab-region)))
- ,@body)
- (t ; Crudely extend the mirrored region.
- (setq -beg- (min -beg- (car c-fl-syn-tab-region))
- -end- (max -end- (cdr c-fl-syn-tab-region)))
- (c-restore-string-fences -beg- -end-)
- ,@body))))
;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text.
;; For our purposes, these are characterized by being possible to
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index f751e72de47..252eec138c1 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -163,7 +163,9 @@
(defvar c-doc-line-join-re)
(defvar c-doc-bright-comment-start-re)
(defvar c-doc-line-join-end-ch)
-(defvar c-fl-syn-tab-region)
+(cc-bytecomp-defvar c-min-syn-tab-mkr)
+(cc-bytecomp-defvar c-max-syn-tab-mkr)
+(cc-bytecomp-defun c-clear-syn-tab)
(cc-bytecomp-defun c-clear-string-fences)
(cc-bytecomp-defun c-restore-string-fences)
@@ -405,7 +407,7 @@ comment at the start of cc-engine.el for more info."
(when (and (car c-macro-cache)
(> (point) (car c-macro-cache)) ; in case we have a
; zero-sized region.
- (not (eq (char-before (1- (point))) ?\\)))
+ (not lim))
(setcdr c-macro-cache (point))
(setq c-macro-cache-syntactic nil)))))))
@@ -1580,6 +1582,7 @@ comment at the start of cc-engine.el for more info."
(save-excursion (backward-char)
(looking-at "\\s("))
(c-crosses-statement-barrier-p (point) end)))))
+(make-obsolete 'c-at-expression-start-p nil "CC mode 5.35")
;; A set of functions that covers various idiosyncrasies in
@@ -1642,6 +1645,21 @@ comment at the start of cc-engine.el for more info."
(forward-char 2)
t))))
+(defmacro c-forward-comment-minus-1 ()
+ "Call (forward-comment -1), taking care of escaped newlines.
+Return the result of `forward-comment' if it gets called, nil otherwise."
+ `(if (not comment-end-can-be-escaped)
+ (forward-comment -1)
+ (when (and (< (skip-syntax-backward " >") 0)
+ (eq (char-after) ?\n))
+ (forward-char))
+ (cond
+ ((and (eq (char-before) ?\n)
+ (eq (char-before (1- (point))) ?\\))
+ (backward-char)
+ nil)
+ (t (forward-comment -1)))))
+
(defun c-backward-single-comment ()
"Move backward past whitespace and the closest preceding comment, if any.
Return t if a comment was found, nil otherwise. In either case, the
@@ -1675,12 +1693,12 @@ This function does not do any hidden buffer changes."
;; same line.
(re-search-forward "\\=\\s *[\n\r]" start t)
- (if (if (forward-comment -1)
+ (if (if (c-forward-comment-minus-1)
(if (eolp)
;; If forward-comment above succeeded and we're at eol
;; then the newline we moved over above didn't end a
;; line comment, so we give it another go.
- (forward-comment -1)
+ (c-forward-comment-minus-1)
t))
;; Emacs <= 20 and XEmacs move back over the closer of a
@@ -1709,7 +1727,7 @@ comment at the start of cc-engine.el for more info."
(if (let (moved-comment)
(while
- (and (not (setq moved-comment (forward-comment -1)))
+ (and (not (setq moved-comment (c-forward-comment-minus-1)))
;; Cope specifically with ^M^J here -
;; forward-comment sometimes gets stuck after ^Ms,
;; sometimes after ^M^J.
@@ -1895,52 +1913,29 @@ comment at the start of cc-engine.el for more info."
(defun c-enclosing-c++-attribute ()
;; If we're in C++ Mode, and point is within a correctly balanced [[ ... ]]
;; attribute structure, return a cons of its starting and ending positions.
- ;; Otherwise, return nil. We use the c-{in,is}-sws-face text properties for
- ;; this determination, this macro being intended only for use in the *-sws-*
- ;; functions and macros. The match data are NOT preserved over this macro.
- (let (attr-end pos-is-sws)
- (and
- (c-major-mode-is 'c++-mode)
- (> (point) (point-min))
- (setq pos-is-sws
- (if (get-text-property (1- (point)) 'c-is-sws)
- (1- (point))
- (1- (previous-single-property-change
- (point) 'c-is-sws nil (point-min)))))
- (save-excursion
- (goto-char pos-is-sws)
- (setq attr-end (c-looking-at-c++-attribute)))
- (> attr-end (point))
- (cons pos-is-sws attr-end))))
-
-(defun c-slow-enclosing-c++-attribute ()
- ;; Like `c-enclosing-c++-attribute', but does not depend on the c-i[ns]-sws
- ;; properties being set.
+ ;; Otherwise, return nil.
(and
(c-major-mode-is 'c++-mode)
(save-excursion
- (let ((paren-state (c-parse-state))
+ (let ((lim (max (- (point) 200) (point-min)))
cand)
(while
- (progn
- (setq cand
- (catch 'found-cand
- (while (cdr paren-state)
- (when (and (numberp (car paren-state))
- (numberp (cadr paren-state))
- (eq (car paren-state)
- (1+ (cadr paren-state)))
- (eq (char-after (car paren-state)) ?\[)
- (eq (char-after (cadr paren-state)) ?\[))
- (throw 'found-cand (cadr paren-state)))
- (setq paren-state (cdr paren-state)))))
- (and cand
- (not
- (and (c-go-list-forward cand)
- (eq (char-before) ?\])
- (eq (char-before (1- (point))) ?\])))))
- (setq paren-state (cdr paren-state)))
- (and cand (cons cand (point)))))))
+ (and
+ (progn
+ (skip-chars-backward "^[;{}" lim)
+ (eq (char-before) ?\[))
+ (not (eq (char-before (1- (point))) ?\[))
+ (> (point) lim))
+ (backward-char))
+ (and (eq (char-before) ?\[)
+ (eq (char-before (1- (point))) ?\[)
+ (progn (backward-char 2) t)
+ (setq cand (point))
+ (c-go-list-forward nil (min (+ (point) 200) (point-max)))
+ (eq (char-before) ?\])
+ (eq (char-before (1- (point))) ?\])
+ (not (c-literal-limits))
+ (cons cand (point)))))))
(defun c-invalidate-sws-region-before (beg end)
;; Called from c-before-change. BEG and END are the bounds of the change
@@ -2243,7 +2238,7 @@ comment at the start of cc-engine.el for more info."
((and c-opt-cpp-prefix
(looking-at c-noise-macro-name-re))
- ;; Skip over a noise macro.
+ ;; Skip over a noise macro without parens.
(goto-char (match-end 1))
(not (eobp)))
@@ -2702,7 +2697,7 @@ comment at the start of cc-engine.el for more info."
;; or the car of the list is the "position element" of ELT, the position
;; where ELT is valid.
;;
- ;; POINT is left at the postition for which the returned state is valid. It
+ ;; POINT is left at the position for which the returned state is valid. It
;; will be either the position element of ELT, or one character before
;; that. (The latter happens in Emacs <= 25 and XEmacs, when ELT indicates
;; its position element directly follows a potential first character of a
@@ -2710,7 +2705,7 @@ comment at the start of cc-engine.el for more info."
(if (and (consp elt) (>= (length elt) 3))
;; Inside a string or comment
(let ((depth 0) (containing nil) (last nil)
- in-string in-comment (after-quote nil)
+ in-string in-comment
(min-depth 0) com-style com-str-start (intermediate nil)
(char-1 (nth 3 elt)) ; first char of poss. 2-char construct
(pos (car elt))
@@ -2772,7 +2767,7 @@ comment at the start of cc-engine.el for more info."
((nth 3 state) ; A string
(list (point) (nth 3 state) (nth 8 state)))
((and (nth 4 state) ; A comment
- (not (eq (nth 7 state) 'syntax-table))) ; but not a psuedo comment.
+ (not (eq (nth 7 state) 'syntax-table))) ; but not a pseudo comment.
(list (point)
(if (eq (nth 7 state) 1) 'c++ 'c)
(nth 8 state)))
@@ -2899,7 +2894,7 @@ comment at the start of cc-engine.el for more info."
(setq nc-list (cdr nc-list))))))
(defun c-semi-get-near-cache-entry (here)
- ;; Return the near cache entry at the highest postion before HERE, if any,
+ ;; Return the near cache entry at the highest position before HERE, if any,
;; or nil. The near cache entry is of the form (POSITION . STATE), where
;; STATE has the form of a result of `parse-partial-sexp'.
(let ((nc-pos-state
@@ -2988,9 +2983,7 @@ comment at the start of cc-engine.el for more info."
c-block-comment-awkward-chars)))
(and (nth 4 s) (nth 7 s) ; Line comment
(not (memq (char-before here) '(?\\ ?\n)))))))
- (c-with-extended-string-fences
- pos here
- (setq s (parse-partial-sexp pos here nil nil s))))
+ (setq s (parse-partial-sexp pos here nil nil s)))
(when (not (eq near-pos here))
(c-semi-put-near-cache-entry here s))
(cond
@@ -3031,7 +3024,7 @@ comment at the start of cc-engine.el for more info."
(defun c-full-trim-near-cache ()
;; Remove stale entries in `c-full-lit-near-cache', i.e. those whose END
;; entries, or positions, are above `c-full-near-cache-limit'.
- (let ((nc-list c-full-lit-near-cache) elt)
+ (let ((nc-list c-full-lit-near-cache))
(while nc-list
(let ((elt (car nc-list)))
(if (if (car (cddr elt))
@@ -3122,7 +3115,7 @@ comment at the start of cc-engine.el for more info."
(not base) ; FIXME!!! Compare base and far-base??
; (2019-05-21)
(not end)
- (> here end))
+ (>= here end))
(progn
(setq far-base-and-state (c-parse-ps-state-below here)
far-base (car far-base-and-state)
@@ -3135,7 +3128,7 @@ comment at the start of cc-engine.el for more info."
(or
(and (> here base) (null end))
(null (nth 8 s))
- (and end (> here end))
+ (and end (>= here end))
(not
(or
(and (nth 3 s) ; string
@@ -3194,6 +3187,24 @@ comment at the start of cc-engine.el for more info."
c-semi-near-cache-limit (min c-semi-near-cache-limit pos)
c-full-near-cache-limit (min c-full-near-cache-limit pos)))
+(defun c-foreign-truncate-lit-pos-cache (beg _end)
+ "Truncate CC Mode's literal cache.
+
+This function should be added to the `before-change-functions'
+hook by major modes that use CC Mode's filling functionality
+without initializing CC Mode. Currently (2020-06) these are
+js-mode and mhtml-mode."
+ (c-truncate-lit-pos-cache beg))
+
+(defun c-foreign-init-lit-pos-cache ()
+ "Initialize CC Mode's literal cache.
+
+This function should be called from the mode functions of major
+modes which use CC Mode's filling functionality without
+initializing CC Mode. Currently (2020-06) these are js-mode and
+mhtml-mode."
+ (c-truncate-lit-pos-cache 1))
+
;; A system for finding noteworthy parens before the point.
@@ -7159,7 +7170,7 @@ comment at the start of cc-engine.el for more info."
;; characters.) If the raw string is not terminated, E\) and E\" are set to
;; nil.
;;
- ;; Note: this function is dependant upon the correct syntax-table text
+ ;; Note: this function is dependent upon the correct syntax-table text
;; properties being set.
(let ((state (c-semi-pp-to-literal (point)))
open-quote-pos open-paren-pos close-paren-pos close-quote-pos id)
@@ -7614,8 +7625,7 @@ comment at the start of cc-engine.el for more info."
;; entire raw string (when properly terminated) or just the delimiter
;; (otherwise). In either of these cases, return t, otherwise return nil.
;;
- (let ((here (point))
- in-macro macro-end id Rquote found)
+ (let (in-macro macro-end)
(when
(and
(eq (char-before (1- (point))) ?R)
@@ -8415,6 +8425,7 @@ comment at the start of cc-engine.el for more info."
;; o - 'found if it's a type that matches one in `c-found-types';
;; o - 'maybe if it's an identifier that might be a type;
;; o - 'decltype if it's a decltype(variable) declaration; - or
+ ;; o - 'no-id if "auto" precluded parsing a type identifier.
;; o - nil if it can't be a type (the point isn't moved then).
;;
;; The point is assumed to be at the beginning of a token.
@@ -8439,9 +8450,12 @@ comment at the start of cc-engine.el for more info."
;; prefix of a type.
(when c-opt-type-modifier-prefix-key ; e.g. "const" "volatile", but NOT "typedef"
(while (looking-at c-opt-type-modifier-prefix-key)
+ (when (looking-at c-no-type-key)
+ (setq res 'no-id))
(goto-char (match-end 1))
(c-forward-syntactic-ws)
- (setq res 'prefix)))
+ (or (eq res 'no-id)
+ (setq res 'prefix))))
(cond
((looking-at c-typeof-key) ; e.g. C++'s "decltype".
@@ -8492,28 +8506,30 @@ comment at the start of cc-engine.el for more info."
(setq res t))
(unless res (goto-char start))) ; invalid syntax
- ((progn
- (setq pos nil)
- (if (looking-at c-identifier-start)
- (save-excursion
- (setq id-start (point)
- name-res (c-forward-name))
- (when name-res
- (setq id-end (point)
- id-range c-last-identifier-range))))
- (and (cond ((looking-at c-primitive-type-key)
- (setq res t))
- ((c-with-syntax-table c-identifier-syntax-table
- (looking-at c-known-type-key))
- (setq res 'known)))
- (or (not id-end)
- (>= (save-excursion
- (save-match-data
- (goto-char (match-end 1))
- (c-forward-syntactic-ws)
- (setq pos (point))))
- id-end)
- (setq res nil))))
+ ((and
+ (not (eq res 'no-id))
+ (progn
+ (setq pos nil)
+ (if (looking-at c-identifier-start)
+ (save-excursion
+ (setq id-start (point)
+ name-res (c-forward-name))
+ (when name-res
+ (setq id-end (point)
+ id-range c-last-identifier-range))))
+ (and (cond ((looking-at c-primitive-type-key)
+ (setq res t))
+ ((c-with-syntax-table c-identifier-syntax-table
+ (looking-at c-known-type-key))
+ (setq res 'known)))
+ (or (not id-end)
+ (>= (save-excursion
+ (save-match-data
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws)
+ (setq pos (point))))
+ id-end)
+ (setq res nil)))))
;; Looking at a primitive or known type identifier. We've
;; checked for a name first so that we don't go here if the
;; known type match only is a prefix of another name.
@@ -8588,7 +8604,7 @@ comment at the start of cc-engine.el for more info."
(goto-char start)
(setq res nil)))))
- (when res
+ (when (not (memq res '(nil no-id)))
;; Skip trailing type modifiers. If any are found we know it's
;; a type.
(when c-opt-type-modifier-key
@@ -9119,6 +9135,12 @@ This function might do hidden buffer changes."
(catch 'is-function
(while
(progn
+ (while
+ (cond
+ ((looking-at c-decl-hangon-key)
+ (c-forward-keyword-clause 1))
+ ((looking-at c-noise-macro-with-parens-name-re)
+ (c-forward-noise-clause))))
(if (eq (char-after) ?\))
(throw 'is-function t))
(setq cdd-got-type (c-forward-type))
@@ -9354,8 +9376,8 @@ This function might do hidden buffer changes."
maybe-typeless
;; Save the value of kwd-sym between loops of the "Check for a
;; type" loop. Needed to distinguish a C++11 "auto" from a pre
- ;; C++11 one.
- prev-kwd-sym
+ ;; C++11 one. (Commented out, 2020-11-01).
+ ;; prev-kwd-sym
;; If a specifier is found that also can be a type prefix,
;; these flags are set instead of those above. If we need to
;; back up an identifier, they are copied to the real flag
@@ -9435,12 +9457,11 @@ This function might do hidden buffer changes."
(when (setq found-type (c-forward-type t)) ; brace-block-too
;; Found a known or possible type or a prefix of a known type.
- (when (and (c-major-mode-is 'c++-mode) ; C++11 style "auto"?
- (eq prev-kwd-sym (c-keyword-sym "auto"))
- (looking-at "[=(]")) ; FIXME!!! proper regexp.
- (setq new-style-auto t)
- (setq found-type nil)
- (goto-char start)) ; position of foo in "auto foo"
+ (when (and (eq found-type 'no-id)
+ (save-excursion
+ (and (c-forward-name) ; over the identifier
+ (looking-at "[=(]")))) ; FIXME!!! proper regexp.
+ (setq new-style-auto t)) ; position of foo in "auto foo"
(when at-type
;; Got two identifiers with nothing but whitespace
@@ -9515,7 +9536,7 @@ This function might do hidden buffer changes."
;; specifier keyword and we know we're in a
;; declaration.
(setq at-decl-or-cast t)
- (setq prev-kwd-sym kwd-sym)
+ ;; (setq prev-kwd-sym kwd-sym)
(goto-char kwd-clause-end))))
@@ -9523,7 +9544,7 @@ This function might do hidden buffer changes."
;; over all specifiers and type identifiers. The reason
;; to do this for a known type prefix is to make things
;; like "unsigned INT16" work.
- (and found-type (not (eq found-type t))))))
+ (and found-type (not (memq found-type '(t no-id)))))))
(cond
((eq at-type t)
@@ -9543,6 +9564,10 @@ This function might do hidden buffer changes."
;; followed by another type.
(setq at-type t))
+ ((eq at-type 'no-id)
+ ;; For an auto type, we assume we definitely have a type construct.
+ (setq at-type t))
+
((not at-type)
;; Got no type but set things up to continue anyway to handle
;; the various cases when a declaration doesn't start with a
@@ -9771,6 +9796,16 @@ This function might do hidden buffer changes."
(save-excursion
(goto-char after-paren-pos)
(c-forward-syntactic-ws)
+ (progn
+ (while
+ (cond
+ ((and
+ c-opt-cpp-prefix
+ (looking-at c-noise-macro-with-parens-name-re))
+ (c-forward-noise-clause))
+ ((looking-at c-decl-hangon-key)
+ (c-forward-keyword-clause 1))))
+ t)
(or (c-forward-type)
;; Recognize a top-level typeless
;; function declaration in C.
@@ -11216,7 +11251,7 @@ comment at the start of cc-engine.el for more info."
(c-syntactic-re-search-forward ";" nil 'move t)))
nil)))
-(defun c-looking-at-decl-block (_containing-sexp goto-start &optional limit)
+(defun c-looking-at-decl-block (goto-start &optional limit)
;; Assuming the point is at an open brace, check if it starts a
;; block that contains another declaration level, i.e. that isn't a
;; statement block or a brace list, and if so return non-nil.
@@ -11396,9 +11431,7 @@ comment at the start of cc-engine.el for more info."
; *c-looking-at-decl-block
; containing-sexp goto-start &optional
; limit)
- (when (and (c-looking-at-decl-block
- (c-pull-open-brace paren-state)
- nil)
+ (when (and (c-looking-at-decl-block nil)
(looking-at c-class-key))
(goto-char (match-end 1))
(c-forward-syntactic-ws)
@@ -11417,9 +11450,7 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(goto-char open-paren-pos)
(when (and (eq (char-after) ?{)
- (c-looking-at-decl-block
- (c-safe-position open-paren-pos paren-state)
- nil))
+ (c-looking-at-decl-block nil))
(back-to-indentation)
(vector (point) open-paren-pos))))))
@@ -11432,7 +11463,7 @@ comment at the start of cc-engine.el for more info."
(while (and open-brace
(save-excursion
(goto-char open-brace)
- (not (c-looking-at-decl-block next-open-brace nil))))
+ (not (c-looking-at-decl-block nil))))
(setq open-brace next-open-brace
next-open-brace (c-pull-open-brace paren-state)))
open-brace))
@@ -11688,7 +11719,16 @@ comment at the start of cc-engine.el for more info."
(not (c-in-literal))
))))
nil)
- (t t))))))
+ (t t)))))
+ ((and
+ (c-major-mode-is 'c++-mode)
+ (eq (char-after) ?\[)
+ ;; Be careful of "operator []"
+ (not (save-excursion
+ (c-backward-token-2 1 nil lim)
+ (looking-at c-opt-op-identifier-prefix))))
+ (setq braceassignp t)
+ nil))
(when (eq braceassignp 'dontknow)
(cond ((and
(not (eq (char-after) ?,))
@@ -11741,7 +11781,7 @@ comment at the start of cc-engine.el for more info."
(goto-char (car res))
(c-do-declarators
(point-max) t nil nil
- (lambda (id-start id-end tok not-top func init)
+ (lambda (id-start _id-end _tok _not-top _func _init)
(cond
((> id-start after-type-id-pos)
(throw 'find-decl nil))
@@ -11831,7 +11871,7 @@ comment at the start of cc-engine.el for more info."
(or accept-in-paren (not (eq (cdr bufpos) 'in-paren)))
(car bufpos))))))
-(defun c-looking-at-special-brace-list (&optional _lim)
+(defun c-looking-at-special-brace-list ()
;; If we're looking at the start of a pike-style list, i.e., `({ })',
;; `([ ])', `(< >)', etc., a cons of a cons of its starting and ending
;; positions and its entry in c-special-brace-lists is returned, nil
@@ -11894,17 +11934,6 @@ comment at the start of cc-engine.el for more info."
(cons (list beg) type)))))
(error nil))))
-(defun c-looking-at-bos (&optional _lim)
- ;; Return non-nil if between two statements or declarations, assuming
- ;; point is not inside a literal or comment.
- ;;
- ;; Obsolete - `c-at-statement-start-p' or `c-at-expression-start-p'
- ;; are recommended instead.
- ;;
- ;; This function might do hidden buffer changes.
- (c-at-statement-start-p))
-(make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1")
-
(defun c-looking-at-statement-block ()
;; Point is at an opening brace. If this is a statement block (i.e. the
;; elements in the block are terminated by semicolons, or the block is
@@ -12075,7 +12104,7 @@ comment at the start of cc-engine.el for more info."
(c-backward-token-2 1 nil lim)
(and
(not (and (c-on-identifier)
- (looking-at c-symbol-chars)))
+ (looking-at c-symbol-char-key)))
(not (looking-at c-opt-op-identifier-prefix)))))))
(cons 'inlambda bracket-pos))
((and c-recognize-paren-inexpr-blocks
@@ -12472,8 +12501,7 @@ comment at the start of cc-engine.el for more info."
(defun c-add-class-syntax (symbol
containing-decl-open
containing-decl-start
- containing-decl-kwd
- _paren-state)
+ containing-decl-kwd)
;; The inclass and class-close syntactic symbols are added in
;; several places and some work is needed to fix everything.
;; Therefore it's collected here.
@@ -12522,7 +12550,7 @@ comment at the start of cc-engine.el for more info."
;; CASE B.1: class-open
((save-excursion
(and (eq (char-after) ?{)
- (c-looking-at-decl-block containing-sexp t)
+ (c-looking-at-decl-block t)
(setq beg-of-same-or-containing-stmt (point))))
(c-add-syntax 'class-open beg-of-same-or-containing-stmt))
@@ -12725,10 +12753,7 @@ comment at the start of cc-engine.el for more info."
(goto-char containing-sexp)
(eq (char-after) ?{))
(setq placeholder
- (c-looking-at-decl-block
- (c-most-enclosing-brace paren-state
- containing-sexp)
- t)))
+ (c-looking-at-decl-block t)))
(setq containing-decl-open containing-sexp
containing-decl-start (point)
containing-sexp nil)
@@ -12970,8 +12995,7 @@ comment at the start of cc-engine.el for more info."
(setq placeholder (c-add-class-syntax 'inclass
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state))
+ containing-decl-kwd))
;; Append access-label with the same anchor point as
;; inclass gets.
(c-append-syntax 'access-label placeholder))
@@ -13043,7 +13067,7 @@ comment at the start of cc-engine.el for more info."
((save-excursion
(let (tmp)
(and (eq char-after-ip ?{)
- (setq tmp (c-looking-at-decl-block containing-sexp t))
+ (setq tmp (c-looking-at-decl-block t))
(progn
(setq placeholder (point))
(goto-char tmp)
@@ -13064,7 +13088,7 @@ comment at the start of cc-engine.el for more info."
(goto-char indent-point)
(skip-chars-forward " \t")
(and (eq (char-after) ?{)
- (c-looking-at-decl-block containing-sexp t)
+ (c-looking-at-decl-block t)
(setq placeholder (point))))
(c-add-syntax 'class-open placeholder))
@@ -13104,8 +13128,7 @@ comment at the start of cc-engine.el for more info."
(c-add-class-syntax 'inclass
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state))
+ containing-decl-kwd))
;; CASE 5A.5: ordinary defun open
(t
@@ -13168,8 +13191,7 @@ comment at the start of cc-engine.el for more info."
(c-add-class-syntax 'inclass
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state)))
+ containing-decl-kwd)))
;; CASE 5B.4: Nether region after a C++ or Java func
;; decl, which could include a `throws' declaration.
@@ -13239,8 +13261,7 @@ comment at the start of cc-engine.el for more info."
(c-add-class-syntax 'inclass
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state)))
+ containing-decl-kwd)))
;; CASE 5C.3: in a Java implements/extends
(injava-inher
@@ -13426,8 +13447,7 @@ comment at the start of cc-engine.el for more info."
(c-add-class-syntax 'class-close
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state))
+ containing-decl-kwd))
;; CASE 5H: we could be looking at subsequent knr-argdecls
((and c-recognize-knr-p
@@ -13548,8 +13568,7 @@ comment at the start of cc-engine.el for more info."
(c-add-class-syntax 'inclass
containing-decl-open
containing-decl-start
- containing-decl-kwd
- paren-state)))
+ containing-decl-kwd)))
(when (and c-syntactic-indentation-in-macros
macro-start
(/= macro-start (c-point 'boi indent-point)))
@@ -13865,7 +13884,7 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(goto-char indent-point)
(c-forward-syntactic-ws (c-point 'eol))
- (c-looking-at-special-brace-list (point)))))
+ (c-looking-at-special-brace-list))))
(c-add-syntax 'brace-entry-open (point))
(c-add-stmt-syntax 'brace-list-entry nil t containing-sexp
paren-state (point))
@@ -13931,9 +13950,7 @@ comment at the start of cc-engine.el for more info."
(and lim
(progn
(goto-char lim)
- (c-looking-at-decl-block
- (c-most-enclosing-brace paren-state lim)
- nil))
+ (c-looking-at-decl-block nil))
(setq placeholder (point))))
(c-backward-to-decl-anchor lim)
(back-to-indentation)
@@ -14101,9 +14118,7 @@ comment at the start of cc-engine.el for more info."
(and (progn
(goto-char placeholder)
(eq (char-after) ?{))
- (c-looking-at-decl-block (c-most-enclosing-brace
- paren-state (point))
- nil))))
+ (c-looking-at-decl-block nil))))
(c-backward-to-decl-anchor lim)
(back-to-indentation)
(c-add-syntax 'defun-block-intro (point)))
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 2cbbc66c14f..bb7e5bea6e6 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1073,17 +1073,18 @@ casts and declarations are fontified. Used on level 2 and higher."
(defun c-font-lock-declarators (limit list types not-top
&optional template-class)
;; Assuming the point is at the start of a declarator in a declaration,
- ;; fontify the identifier it declares. (If TYPES is set, it does this via
- ;; the macro `c-fontify-types-and-refs'.)
+ ;; fontify the identifier it declares. (If TYPES is t, it does this via the
+ ;; macro `c-fontify-types-and-refs'.)
;;
;; If LIST is non-nil, also fontify the ids in any following declarators in
;; a comma separated list (e.g. "foo" and "*bar" in "int foo = 17, *bar;");
;; additionally, mark the commas with c-type property 'c-decl-id-start or
;; 'c-decl-type-start (according to TYPES). Stop at LIMIT.
;;
- ;; If TYPES is non-nil, fontify all identifiers as types. If NOT-TOP is
- ;; non-nil, we are not at the top-level ("top-level" includes being directly
- ;; inside a class or namespace, etc.).
+ ;; If TYPES is t, fontify all identifiers as types, if it is nil fontify as
+ ;; either variables or functions, otherwise TYPES is a face to use. If
+ ;; NOT-TOP is non-nil, we are not at the top-level ("top-level" includes
+ ;; being directly inside a class or namespace, etc.).
;;
;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters
;; and was introduced by, e.g. "typename" or "class", such that if there is
@@ -1100,9 +1101,10 @@ casts and declarations are fontified. Used on level 2 and higher."
()
(c-do-declarators
limit list not-top
- (if types 'c-decl-type-start 'c-decl-id-start)
+ (cond ((eq types t) 'c-decl-type-start)
+ ((null types) 'c-decl-id-start))
(lambda (id-start _id-end end-pos _not-top is-function init-char)
- (if types
+ (if (eq types t)
;; Register and fontify the identifier as a type.
(let ((c-promote-possible-types t))
(goto-char id-start)
@@ -1121,9 +1123,10 @@ casts and declarations are fontified. Used on level 2 and higher."
;; `c-forward-declarator'.
(c-put-font-lock-face (car c-last-identifier-range)
(cdr c-last-identifier-range)
- (if is-function
- 'font-lock-function-name-face
- 'font-lock-variable-name-face))))
+ (cond
+ ((not (memq types '(nil t))) types)
+ (is-function 'font-lock-function-name-face)
+ (t 'font-lock-variable-name-face)))))
(and template-class
(eq init-char ?=) ; C++ "<class X = Y>"?
(progn
@@ -1357,7 +1360,8 @@ casts and declarations are fontified. Used on level 2 and higher."
'c-decl-id-start)))))
(c-font-lock-declarators
(min limit (point-max)) decl-list
- (cadr decl-or-cast) (not toplev) template-class))
+ (not (null (cadr decl-or-cast)))
+ (not toplev) template-class))
;; A declaration has been successfully identified, so do all the
;; fontification of types and refs that've been recorded.
@@ -2004,6 +2008,9 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'."
,@(when (c-major-mode-is 'c++-mode)
'(c-font-lock-c++-lambda-captures))
+ ,@(when (c-lang-const c-using-key)
+ `(c-font-lock-c++-using))
+
;; The first two rules here mostly find occurrences that
;; `c-font-lock-declarations' has found already, but not
;; declarations containing blocks in the type (see note below).
@@ -2263,6 +2270,40 @@ need for `c-font-lock-extra-types'.")
;;; C++.
+(defun c-font-lock-c++-using (limit)
+ ;; Fontify any clauses starting with the keyword `using'.
+ ;;
+ ;; This function will be called from font-lock- for a region bounded by
+ ;; POINT and LIMIT, as though it were to identify a keyword for
+ ;; font-lock-keyword-face. It always returns NIL to inhibit this and
+ ;; prevent a repeat invocation. See elisp/lispref page "Search-based
+ ;; fontification".
+ (let (pos after-name)
+ (while (c-syntactic-re-search-forward c-using-key limit 'end)
+ (while ; Do one declarator of a comma separated list, each time around.
+ (progn
+ (c-forward-syntactic-ws)
+ (setq pos (point)) ; token after "using".
+ (when (and (c-on-identifier)
+ (c-forward-name))
+ (setq after-name (point))
+ (cond
+ ((eq (char-after) ?=) ; using foo = <type-id>;
+ (goto-char pos)
+ (c-font-lock-declarators limit nil t nil))
+ ((save-excursion
+ (and c-colon-type-list-re
+ (c-go-up-list-backward)
+ (eq (char-after) ?{)
+ (eq (car (c-beginning-of-decl-1)) 'same)
+ (looking-at c-colon-type-list-re)))
+ ;; Inherited protected member: leave unfontified
+ )
+ (t (goto-char pos)
+ (c-font-lock-declarators limit nil c-label-face-name nil)))
+ (eq (char-after) ?,)))
+ (forward-char))) ; over the comma.
+ nil))
(defun c-font-lock-c++-new (limit)
;; FIXME!!! Put in a comment about the context of this function's
@@ -3016,6 +3057,84 @@ need for `pike-font-lock-extra-types'.")
(c-font-lock-doc-comments "/[*/]!" limit
autodoc-font-lock-doc-comments)))))
+;; Doxygen
+
+(defconst doxygen-font-lock-doc-comments
+ ;; TODO: Handle @code, @verbatim, @dot, @f etc. better by not highlighting
+ ;; text inside of those commands. Something smarter than just regexes may be
+ ;; needed to do that efficiently.
+ `((,(concat
+ ;; Make sure that the special character has not been escaped. E.g. in
+ ;; `\@foo' only `\@' is a command (similarly for other characters like
+ ;; `\\foo', `\<foo' and `\&foo'). The downside now is that we don't
+ ;; match command started just after an escaped character, e.g. in
+ ;; `\@\foo' we should match `\@' as well as `\foo' but only the former
+ ;; is matched.
+ "\\(?:^\\|[^\\@]\\)\\("
+ ;; Doxygen commands start with backslash or an at sign. Note that for
+ ;; brevity in the comments only `\' will be mentioned.
+ "[\\@]\\(?:"
+ ;; Doxygen commands except those starting with `f'
+ "[a-eg-z][a-z]*"
+ ;; Doxygen command starting with `f':
+ "\\|f\\(?:"
+ "[][$}]" ; \f$ \f} \f[ \f]
+ "\\|{\\(?:[a-zA-Z]+\\*?}{?\\)?" ; \f{ \f{env} \f{env}{
+ "\\|[a-z]+" ; \foo
+ "\\)"
+ "\\|~[a-zA-Z]*" ; \~ \~language
+ "\\|[$@&~<=>#%\".|\\\\]" ; single-character escapes
+ "\\|::\\|---?" ; \:: \-- \---
+ "\\)"
+ ;; HTML tags and entities:
+ "\\|</?\\sw\\(?:\\sw\\|\\s \\|[=\n\r*.:]\\|\"[^\"]*\"\\|'[^']*'\\)*>"
+ "\\|&\\(?:\\sw+\\|#[0-9]+\\|#x[0-9a-fA-F]+\\);"
+ "\\)")
+ 1 ,c-doc-markup-face-name prepend nil)
+ ;; Commands inside of strings are not commands so override highlighting with
+ ;; string face. This also affects HTML attribute values if they are
+ ;; surrounded with double quotes which may or may not be considered a good
+ ;; thing.
+ ("\\(?:^\\|[^\\@]\\)\\(\"[^\"[:cntrl:]]+\"\\)"
+ 1 font-lock-string-face prepend nil)
+ ;; HTML comments inside of the Doxygen comments.
+ ("\\(?:^\\|[^\\@]\\)\\(<!--.*?-->\\)"
+ 1 font-lock-comment-face prepend nil)
+ ;; Autolinking. Doxygen auto-links anything that is a class name but we have
+ ;; no hope of matching those. We are, however, able to match functions and
+ ;; members using explicit scoped syntax. For functions, we can also find
+ ;; them by noticing argument-list. Note that Doxygen accepts `::' as well
+ ;; as `#' as scope operators.
+ (,(let* ((ref "[\\@]ref\\s-+")
+ (ref-opt (concat "\\(?:" ref "\\)?"))
+ (id "[a-zA-Z_][a-zA-Z_0-9]*")
+ (args "\\(?:()\\|([^()]*)\\)")
+ (scope "\\(?:#\\|::\\)"))
+ (concat
+ "\\(?:^\\|[^\\@/%:]\\)\\(?:"
+ ref-opt "\\(?1:" scope "?" "\\(?:" id scope "\\)+" "~?" id "\\)"
+ "\\|" ref-opt "\\(?1:" scope "~?" id "\\)"
+ "\\|" ref-opt "\\(?1:" scope "?" "~?" id "\\)" args
+ "\\|" ref "\\(?1:" "~?" id "\\)"
+ "\\|" ref-opt "\\(?1:~[A-Z][a-zA-Z0-9_]+\\)"
+ "\\)"))
+ 1 font-lock-function-name-face prepend nil)
+ ;; Match URLs and emails. This has two purposes. First of all, Doxygen
+ ;; autolinks URLs. Second of all, `@bar' in `foo@bar.baz' has been matched
+ ;; above as a command; try and overwrite it.
+ (,(let* ((host "[A-Za-z0-9]\\(?:[A-Za-z0-9-]\\{0,61\\}[A-Za-z0-9]\\)")
+ (fqdn (concat "\\(?:" host "\\.\\)+" host))
+ (comp "[!-(*--/-=?-~]+")
+ (path (concat "/\\(?:" comp "[.]+" "\\)*" comp)))
+ (concat "\\(?:mailto:\\)?[a-zA-0_.]+@" fqdn
+ "\\|https?://" fqdn "\\(?:" path "\\)?"))
+ 0 font-lock-keyword-face prepend nil)))
+
+(defconst doxygen-font-lock-keywords
+ `((,(lambda (limit)
+ (c-font-lock-doc-comments "/\\(?:/[/!]\\|\\*[\\*!]\\)"
+ limit doxygen-font-lock-doc-comments)))))
+
;; 2006-07-10: awk-font-lock-keywords has been moved back to cc-awk.el.
(cc-provide 'cc-fonts)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 0a7f4565c0e..80c461c76cb 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1174,7 +1174,7 @@ since CC Mode treats every identifier as an expression."
;; Exception.
,@(when (c-major-mode-is 'c++-mode)
- '((prefix "throw")))
+ '((prefix "throw" "co_await" "co_yield")))
;; Sequence.
(left-assoc ","))
@@ -1769,7 +1769,7 @@ ender."
`comment-start-skip' is initialized from this."
;; Default: Allow the last char of the comment starter(s) to be
;; repeated, then allow any amount of horizontal whitespace.
- t (concat "\\("
+ t (concat "\\(?:"
(c-concat-separated
(mapcar (lambda (cs)
(when cs
@@ -2040,6 +2040,7 @@ the appropriate place for that."
(c-lang-defconst c-return-kwds
"Keywords which return a value to the calling function."
t '("return")
+ c++ '("return" "co_return")
idl nil)
(c-lang-defconst c-return-key
@@ -2120,7 +2121,9 @@ fontified with the keyword face and not the type face."
t nil
c '("const" "restrict" "volatile")
c++ '("const" "noexcept" "volatile")
- objc '("const" "volatile"))
+ objc '("const" "volatile")
+ t (append (c-lang-const c-no-type-kwds)
+ (c-lang-const c-type-modifier-prefix-kwds)))
(c-lang-defconst c-opt-type-modifier-prefix-key
;; Adorned regexp matching `c-type-modifier-prefix-kwds', or nil in
@@ -2337,6 +2340,26 @@ will be handled."
t (c-make-keywords-re t (c-lang-const c-typedef-decl-kwds)))
(c-lang-defvar c-typedef-decl-key (c-lang-const c-typedef-decl-key))
+(c-lang-defconst c-using-kwds
+ "Keywords which behave like `using' in C++"
+ t nil
+ c++ '("using"))
+
+(c-lang-defconst c-using-key
+ ;; Regexp matching C++'s `using'.
+ t (c-make-keywords-re t (c-lang-const c-using-kwds)))
+(c-lang-defvar c-using-key (c-lang-const c-using-key))
+
+(c-lang-defconst c-no-type-kwds
+ "Keywords which remove the need to specify a type in declarations"
+ t nil
+ c++ '("auto"))
+
+(c-lang-defconst c-no-type-key
+ ;; Regexp matching an entry from `c-no-type-kwds'
+ t (c-make-keywords-re t (c-lang-const c-no-type-kwds)))
+(c-lang-defvar c-no-type-key (c-lang-const c-no-type-key))
+
(c-lang-defconst c-typeless-decl-kwds
"Keywords introducing declarations where the (first) identifier
\(declarator) follows directly after the keyword, without any type.
@@ -2350,7 +2373,6 @@ will be handled."
;; {...}").
t (append (c-lang-const c-class-decl-kwds)
(c-lang-const c-brace-list-decl-kwds))
- c++ (append (c-lang-const c-typeless-decl-kwds) '("auto")) ; C++11.
;; Note: "manages" for CORBA CIDL clashes with its presence on
;; `c-type-list-kwds' for IDL.
idl (append (c-lang-const c-typeless-decl-kwds)
@@ -2385,9 +2407,11 @@ If any of these also are on `c-type-list-kwds', `c-ref-list-kwds',
`c-<>-type-kwds', or `c-<>-arglist-kwds' then the associated clauses
will be handled."
t nil
- (c c++) '("auto" "extern" "inline" "register" "static")
+ (c c++) '("extern" "inline" "register" "static")
+ c (append '("auto") (c-lang-const c-modifier-kwds))
c++ (append '("constexpr" "explicit" "friend" "mutable" "template"
- "thread_local" "using" "virtual")
+ "thread_local" "virtual")
+ ;; "using" is now handled specially (2020-09-14).
(c-lang-const c-modifier-kwds))
objc '("auto" "bycopy" "byref" "extern" "in" "inout" "oneway" "out" "static")
;; FIXME: Some of those below ought to be on `c-other-decl-kwds' instead.
@@ -2415,7 +2439,8 @@ If any of these also are on `c-type-list-kwds', `c-ref-list-kwds',
`c-<>-type-kwds', or `c-<>-arglist-kwds' then the associated clauses
will be handled."
t nil
- objc '("@class" "@end" "@defs")
+ objc '("@class" "@defs" "@end" "@property" "@dynamic" "@synthesize"
+ "@compatibility_alias")
java '("import" "package")
pike '("import" "inherit"))
@@ -2538,7 +2563,8 @@ one of `c-type-list-kwds', `c-ref-list-kwds',
"Access protection label keywords in classes."
t nil
c++ '("private" "protected" "public")
- objc '("@private" "@protected" "@public"))
+ objc '("@private" "@protected" "@package" "@public"
+ "@required" "@optional"))
(c-lang-defconst c-protection-key
;; A regexp match an element of `c-protection-kwds' cleanly.
@@ -2753,7 +2779,7 @@ identifiers that follows the type in a normal declaration."
"Statement keywords followed directly by a substatement."
t '("do" "else")
c++ '("do" "else" "try")
- objc '("do" "else" "@finally" "@try")
+ objc '("do" "else" "@finally" "@try" "@autoreleasepool")
java '("do" "else" "finally" "try")
idl nil)
@@ -2783,7 +2809,7 @@ Keywords here should also be in `c-block-stmt-1-kwds'."
java '("for" "if" "switch" "while" "catch" "synchronized")
idl nil
pike '("for" "if" "switch" "while" "foreach")
- awk '("for" "if" "while"))
+ awk '("for" "if" "switch" "while"))
(c-lang-defconst c-block-stmt-2-key
;; Regexp matching the start of any statement followed by a paren sexp
@@ -2822,6 +2848,7 @@ Keywords here should also be in `c-block-stmt-1-kwds'."
(c-lang-defconst c-simple-stmt-kwds
"Statement keywords followed by an expression or nothing."
t '("break" "continue" "goto" "return")
+ c++ '("break" "continue" "goto" "return" "co_return")
objc '("break" "continue" "goto" "return" "@throw")
;; Note: `goto' is not valid in Java, but the keyword is still reserved.
java '("break" "continue" "goto" "return" "throw")
@@ -2862,8 +2889,7 @@ nevertheless contains a list separated with `;' and not `,'."
(c-lang-defconst c-case-kwds
"The keyword(s) which introduce a \"case\" like construct.
This construct is \"<keyword> <expression> :\"."
- t '("case")
- awk nil)
+ t '("case"))
(c-lang-defconst c-case-kwds-regexp
;; Adorned regexp matching any "case"-like keyword.
@@ -2895,7 +2921,8 @@ This construct is \"<keyword> <expression> :\"."
c++ (append
'("nullptr")
(c-lang-const c-constant-kwds c))
- objc '("nil" "Nil" "YES" "NO" "NS_DURING" "NS_HANDLER" "NS_ENDHANDLER")
+ objc '("nil" "Nil" "YES" "NO" "IBAction" "IBOutlet"
+ "NS_DURING" "NS_HANDLER" "NS_ENDHANDLER")
idl '("TRUE" "FALSE")
java '("true" "false" "null") ; technically "literals", not keywords
pike '("UNDEFINED")) ;; Not a keyword, but practically works as one.
@@ -3030,7 +3057,14 @@ Note that Java specific rules are currently applied to tell this from
;; can start a declaration.)
"entity" "process" "service" "session" "storage"))
-
+(c-lang-defconst c-std-abbrev-keywords
+ "List of keywords which may need to cause electric indentation."
+ t '("else" "while")
+ c++ (append (c-lang-const c-std-abbrev-keywords) '("catch"))
+ java (append (c-lang-const c-std-abbrev-keywords) '("catch" "finally"))
+ idl nil)
+(c-lang-defvar c-std-abbrev-keywords (c-lang-const c-std-abbrev-keywords))
+
;;; Constants built from keywords.
;; Note: No `*-kwds' language constants may be defined below this point.
@@ -3405,8 +3439,14 @@ regexp should match \"(\" if parentheses are valid in declarators.
The end of the first submatch is taken as the end of the operator.
Identifier syntax is in effect when this is matched (see
`c-identifier-syntax-table')."
- t (if (c-lang-const c-type-modifier-kwds)
- (concat (regexp-opt (c-lang-const c-type-modifier-kwds) t) "\\>")
+ t (if (or (c-lang-const c-type-modifier-kwds) (c-lang-const c-modifier-kwds))
+ (concat
+ (regexp-opt (c--delete-duplicates
+ (append (c-lang-const c-type-modifier-kwds)
+ (c-lang-const c-modifier-kwds))
+ :test 'string-equal)
+ t)
+ "\\>")
;; Default to a regexp that never matches.
regexp-unmatchable)
;; Check that there's no "=" afterwards to avoid matching tokens
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 74afeecf8f7..c5201d1af54 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -278,6 +278,29 @@ control). See \"cc-mode.el\" for more info."
(setq defs (cdr defs)))))
(put 'c-define-abbrev-table 'lisp-indent-function 1)
+(defun c-populate-abbrev-table ()
+ ;; Insert the standard keywords which may need electric indentation into the
+ ;; current mode's abbreviation table.
+ (let ((table (intern (concat (symbol-name major-mode) "-abbrev-table")))
+ (defs c-std-abbrev-keywords)
+ )
+ (unless (and (boundp table)
+ (abbrev-table-p (symbol-value table)))
+ (define-abbrev-table table nil))
+ (setq local-abbrev-table (symbol-value table))
+ (while defs
+ (unless (intern-soft (car defs) local-abbrev-table) ; Don't overwrite the
+ ; abbrev's use count.
+ (condition-case nil
+ (define-abbrev (symbol-value table)
+ (car defs) (car defs)
+ 'c-electric-continued-statement 0 t)
+ (wrong-number-of-arguments
+ (define-abbrev (symbol-value table)
+ (car defs) (car defs)
+ 'c-electric-continued-statement 0))))
+ (setq defs (cdr defs)))))
+
(defun c-bind-special-erase-keys ()
;; Only used in Emacs to bind C-c C-<delete> and C-c C-<backspace>
;; to the proper keys depending on `normal-erase-is-backspace'.
@@ -535,6 +558,18 @@ preferably use the `c-mode-menu' language constant directly."
;; and `after-change-functions'. Note that this variable is not set when
;; `c-before-change' is invoked by a change to text properties.
+(defvar c-min-syn-tab-mkr nil)
+;; The minimum buffer position where there's a `c-fl-syn-tab' text property,
+;; or nil if there aren't any. This is a marker, or nil if there's currently
+;; no such text property.
+(make-variable-buffer-local 'c-min-syn-tab-mkr)
+
+(defvar c-max-syn-tab-mkr nil)
+;; The maximum buffer position plus 1 where there's a `c-fl-syn-tab' text
+;; property, or nil if there aren't any. This is a marker, or nil if there's
+;; currently no such text property.
+(make-variable-buffer-local 'c-max-syn-tab-mkr)
+
(defun c-basic-common-init (mode default-style)
"Do the necessary initialization for the syntax handling routines
and the line breaking/filling code. Intended to be used by other
@@ -550,6 +585,8 @@ that requires a literal mode spec at compile time."
(setq c-buffer-is-cc-mode mode)
+ (c-populate-abbrev-table)
+
;; these variables should always be buffer local; they do not affect
;; indentation style.
(make-local-variable 'comment-start)
@@ -606,6 +643,10 @@ that requires a literal mode spec at compile time."
;; Initialize the "brace stack" cache.
(c-init-bs-cache)
+ ;; Keep track of where `c-fl-syn-tab' text properties are set.
+ (setq c-min-syn-tab-mkr nil)
+ (setq c-max-syn-tab-mkr nil)
+
(when (or c-recognize-<>-arglists
(c-major-mode-is 'awk-mode)
(c-major-mode-is '(java-mode c-mode c++-mode objc-mode pike-mode)))
@@ -1207,52 +1248,94 @@ Note that the style variables are always made local to the buffer."
(c-put-syn-tab (1- (point)) '(15)))
(t nil)))))
-(defvar c-fl-syn-tab-region nil)
- ;; Non-nil when a `c-restore-string-fences' is "in force". It's value is a
- ;; cons of the BEG and END of the region currently "mirroring" the
- ;; c-fl-syn-tab properties as syntax-table properties.
+(defun c-put-syn-tab (pos value)
+ ;; Set both the syntax-table and the c-fl-syn-tab text properties at POS to
+ ;; VALUE (which should not be nil).
+ ;; `(let ((-pos- ,pos)
+ ;; (-value- ,value))
+ (c-put-char-property pos 'syntax-table value)
+ (c-put-char-property pos 'c-fl-syn-tab value)
+ (cond
+ ((null c-min-syn-tab-mkr)
+ (setq c-min-syn-tab-mkr (copy-marker pos t)))
+ ((< pos c-min-syn-tab-mkr)
+ (move-marker c-min-syn-tab-mkr pos)))
+ (cond
+ ((null c-max-syn-tab-mkr)
+ (setq c-max-syn-tab-mkr (copy-marker (1+ pos) nil)))
+ ((>= pos c-max-syn-tab-mkr)
+ (move-marker c-max-syn-tab-mkr (1+ pos))))
+ (c-truncate-lit-pos-cache pos))
+
+(defun c-clear-syn-tab (pos)
+ ;; Remove both the 'syntax-table and `c-fl-syn-tab properties at POS.
+ (c-clear-char-property pos 'syntax-table)
+ (c-clear-char-property pos 'c-fl-syn-tab)
+ (when c-min-syn-tab-mkr
+ (if (and (eq pos (marker-position c-min-syn-tab-mkr))
+ (eq (1+ pos) (marker-position c-max-syn-tab-mkr)))
+ (progn
+ (move-marker c-min-syn-tab-mkr nil)
+ (move-marker c-max-syn-tab-mkr nil)
+ (setq c-min-syn-tab-mkr nil c-max-syn-tab-mkr nil))
+ (when (eq pos (marker-position c-min-syn-tab-mkr))
+ (move-marker c-min-syn-tab-mkr
+ (if (c-get-char-property (1+ pos) 'c-fl-syn-tab)
+ (1+ pos)
+ (c-next-single-property-change
+ (1+ pos) 'c-fl-syn-tab nil c-max-syn-tab-mkr))))
+ (when (eq (1+ pos) (marker-position c-max-syn-tab-mkr))
+ (move-marker c-max-syn-tab-mkr
+ (if (c-get-char-property (1- pos) 'c-fl-syn-tab)
+ pos
+ (c-previous-single-property-change
+ pos 'c-fl-syn-tab nil (1+ c-min-syn-tab-mkr)))))))
+ (c-truncate-lit-pos-cache pos))
(defun c-clear-string-fences ()
- ;; Clear syntax-table text properties in the region defined by
- ;; `c-cl-syn-tab-region' which are "mirrored" by c-fl-syn-tab text
- ;; properties. However, any such " character which ends up not being
+ ;; Clear syntax-table text properties which are "mirrored" by c-fl-syn-tab
+ ;; text properties. However, any such " character which ends up not being
;; balanced by another " is left with a '(1) syntax-table property.
- (when c-fl-syn-tab-region
- (let ((beg (car c-fl-syn-tab-region))
- (end (cdr c-fl-syn-tab-region))
- s pos)
- (setq pos beg)
+ (when
+ (and c-min-syn-tab-mkr c-max-syn-tab-mkr)
+ (let (s pos)
+ (setq pos c-min-syn-tab-mkr)
(while
(and
- (< pos end)
- (setq pos
- (c-min-property-position pos end 'c-fl-syn-tab))
- (< pos end))
+ (< pos c-max-syn-tab-mkr)
+ (setq pos (c-min-property-position pos
+ c-max-syn-tab-mkr
+ 'c-fl-syn-tab))
+ (< pos c-max-syn-tab-mkr))
(c-clear-char-property pos 'syntax-table)
(setq pos (1+ pos)))
;; Check we haven't left any unbalanced "s.
(save-excursion
- (setq pos beg)
+ (setq pos c-min-syn-tab-mkr)
;; Is there already an unbalanced " before BEG?
- (setq pos (c-min-property-position pos end 'c-fl-syn-tab))
- (when (< pos end) (goto-char pos))
+ (setq pos (c-min-property-position pos c-max-syn-tab-mkr
+ 'c-fl-syn-tab))
+ (when (< pos c-max-syn-tab-mkr)
+ (goto-char pos))
(when (and (save-match-data
(c-search-backward-char-property-with-value-on-char
'c-fl-syn-tab '(15) ?\"
(max (- (point) 500) (point-min))))
(not (equal (c-get-char-property (point) 'syntax-table) '(1))))
(setq pos (1+ pos)))
- (while (< pos end)
+ (while (< pos c-max-syn-tab-mkr)
(setq pos
- (c-min-property-position pos end 'c-fl-syn-tab))
- (when (< pos end)
+ (c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab))
+ (when (< pos c-max-syn-tab-mkr)
(if (memq (char-after pos) c-string-delims)
(progn
;; Step over the ".
- (setq s (parse-partial-sexp pos end nil nil nil
+ (setq s (parse-partial-sexp pos c-max-syn-tab-mkr
+ nil nil nil
'syntax-table))
;; Seek a (bogus) matching ".
- (setq s (parse-partial-sexp (point) end nil nil s
+ (setq s (parse-partial-sexp (point) c-max-syn-tab-mkr
+ nil nil s
'syntax-table))
;; When a bogus matching " is found, do nothing.
;; Otherwise mark the " with 'syntax-table '(1).
@@ -1262,23 +1345,22 @@ Note that the style variables are always made local to the buffer."
(c-get-char-property (1- (point)) 'c-fl-syn-tab))
(c-put-char-property pos 'syntax-table '(1)))
(setq pos (point)))
- (setq pos (1+ pos))))))
- (setq c-fl-syn-tab-region nil))))
-
-(defun c-restore-string-fences (beg end)
- ;; Restore any syntax-table text properties in the region (BEG END) which
- ;; are "mirrored" by c-fl-syn-tab text properties.
- (let ((pos beg))
- (while
- (and
- (< pos end)
- (setq pos
- (c-min-property-position pos end 'c-fl-syn-tab))
- (< pos end))
- (c-put-char-property pos 'syntax-table
- (c-get-char-property pos 'c-fl-syn-tab))
- (setq pos (1+ pos)))
- (setq c-fl-syn-tab-region (cons beg end))))
+ (setq pos (1+ pos)))))))))
+
+(defun c-restore-string-fences ()
+ ;; Restore any syntax-table text properties which are "mirrored" by
+ ;; c-fl-syn-tab text properties.
+ (when (and c-min-syn-tab-mkr c-max-syn-tab-mkr)
+ (let ((pos c-min-syn-tab-mkr))
+ (while
+ (and
+ (< pos c-max-syn-tab-mkr)
+ (setq pos
+ (c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab))
+ (< pos c-max-syn-tab-mkr))
+ (c-put-char-property pos 'syntax-table
+ (c-get-char-property pos 'c-fl-syn-tab))
+ (setq pos (1+ pos))))))
(defvar c-bc-changed-stringiness nil)
;; Non-nil when, in a before-change function, the deletion of a range of text
@@ -1396,9 +1478,11 @@ Note that the style variables are always made local to the buffer."
(c-will-be-escaped end beg end))
(c-remove-string-fences end)
(goto-char (1+ end)))
- ;; Are we unescaping a newline by inserting stuff between \ and \n?
- ((and (eq end beg)
- (c-is-escaped end))
+ ;; Are we unescaping a newline ...
+ ((and
+ (c-is-escaped end)
+ (or (eq beg end) ; .... by inserting stuff between \ and \n?
+ (c-will-be-unescaped beg))) ; ... by removing an odd number of \s?
(goto-char (1+ end))) ; To after the NL which is being unescaped.
(t
(goto-char end)))
@@ -1406,7 +1490,7 @@ Note that the style variables are always made local to the buffer."
;; Move to end of logical line (as it will be after the change, or as it
;; was before unescaping a NL.)
- (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*" nil t)
+ (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*" nil t)
;; We're at an EOLL or point-max.
(if (equal (c-get-char-property (point) 'syntax-table) '(15))
(if (memq (char-after) '(?\n ?\r))
@@ -1436,10 +1520,11 @@ Note that the style variables are always made local to the buffer."
(not (c-characterp c-multiline-string-start-char))))
(when (and (eq end-literal-type 'string)
(not (eq (char-before (cdr end-limits)) ?\())
- (memq (char-after (car end-limits)) c-string-delims)
- (equal (c-get-char-property (car end-limits) 'syntax-table)
- '(15)))
- (c-remove-string-fences (car end-limits))
+ (memq (char-after (car end-limits)) c-string-delims))
+ (setq c-new-END (max c-new-END (cdr end-limits)))
+ (when (equal (c-get-char-property (car end-limits) 'syntax-table)
+ '(15))
+ (c-remove-string-fences (car end-limits)))
(setq c-new-END (max c-new-END (cdr end-limits))))
(when (and (eq beg-literal-type 'string)
@@ -1512,9 +1597,13 @@ Note that the style variables are always made local to the buffer."
; insertion/deletion of string delimiters.
(max
(progn
- (goto-char (min (1+ end) ; 1+, in case a NL has become escaped.
- (point-max)))
- (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*"
+ (goto-char
+ (if (and (memq (char-after end) '(?\n ?\r))
+ (c-is-escaped end))
+ (min (1+ end) ; 1+, if we're inside an escaped NL.
+ (point-max))
+ end))
+ (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
nil t)
(point))
c-new-END))
@@ -1595,7 +1684,7 @@ Note that the style variables are always made local to the buffer."
(c-beginning-of-macro))))
(goto-char (1+ end)) ; After the \
;; Search forward for EOLL
- (setq lim (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*"
+ (setq lim (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
nil t))
(goto-char (1+ end))
(when (c-search-forward-char-property-with-value-on-char
@@ -1888,7 +1977,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(widen)
(unwind-protect
(progn
- (c-restore-string-fences (point-min) (point-max))
+ (c-restore-string-fences)
(save-excursion
;; Are we inserting/deleting stuff in the middle of an
;; identifier?
@@ -2018,7 +2107,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(widen)
(unwind-protect
(progn
- (c-restore-string-fences (point-min) (point-max))
+ (c-restore-string-fences)
(when (> end (point-max))
;; Some emacsen might return positions past the end. This
;; has been observed in Emacs 20.7 when rereading a buffer
@@ -2177,25 +2266,45 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(defun c-fl-decl-end (pos)
;; If POS is inside a declarator, return the end of the token that follows
;; the declarator, otherwise return nil. POS being in a literal does not
- ;; count as being in a declarator (on pragmatic grounds).
+ ;; count as being in a declarator (on pragmatic grounds). POINT is not
+ ;; preserved.
(goto-char pos)
(let ((lit-start (c-literal-start))
enclosing-attribute pos1)
(unless lit-start
(c-backward-syntactic-ws)
- (when (setq enclosing-attribute (c-slow-enclosing-c++-attribute))
+ (when (setq enclosing-attribute (c-enclosing-c++-attribute))
(goto-char (car enclosing-attribute))) ; Only happens in C++ Mode.
(when (setq pos1 (c-on-identifier))
(goto-char pos1)
(let ((lim (save-excursion
(and (c-beginning-of-macro)
(progn (c-end-of-macro) (point))))))
- (when (and (c-forward-declarator lim)
- (or (not (eq (char-after) ?\())
- (c-go-list-forward nil lim))
- (eq (c-forward-token-2 1 nil lim) 0))
- (c-backward-syntactic-ws)
- (point)))))))
+ (and (c-forward-declarator lim)
+ (if (eq (char-after) ?\()
+ (and
+ (c-go-list-forward nil lim)
+ (progn (c-forward-syntactic-ws lim)
+ (not (eobp)))
+ (progn
+ (if (looking-at c-symbol-char-key)
+ ;; Deal with baz (foo((bar)) type var), where
+ ;; foo((bar)) is not semantically valid. The result
+ ;; must be after var).
+ (and
+ (goto-char pos)
+ (setq pos1 (c-on-identifier))
+ (goto-char pos1)
+ (progn
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?\())
+ (c-fl-decl-end (1- (point))))
+ (c-backward-syntactic-ws)
+ (point))))
+ (and (progn (c-forward-syntactic-ws lim)
+ (not (eobp)))
+ (c-backward-syntactic-ws)
+ (point)))))))))
(defun c-change-expand-fl-region (_beg _end _old-len)
;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock
@@ -2255,69 +2364,48 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
;; line was fouled up by context fontification.
(save-restriction
(widen)
- (let (new-beg new-end new-region case-fold-search string-fence-beg lim)
- ;; Check how far back we need to extend the region where we reapply the
- ;; string fence syntax-table properties. These must be in place for the
- ;; coming fontification operations.
- (save-excursion
- (goto-char (if c-in-after-change-fontification
- (min beg c-new-BEG)
- beg))
- (setq lim (max (- (point) 500) (point-min)))
- (while
+ (let (new-beg new-end new-region case-fold-search)
+ (c-save-buffer-state nil
+ ;; Temporarily reapply the string fence syntax-table properties.
+ (unwind-protect
(progn
- (skip-chars-backward "^\"" lim)
- (or (bobp) (backward-char))
- (save-excursion
- (eq (logand (skip-chars-backward "\\\\") 1) 1))))
- (setq string-fence-beg
- (cond ((c-get-char-property (point) 'c-fl-syn-tab)
- (point))
- (c-in-after-change-fontification
- c-new-BEG)
- (t beg)))
- (c-save-buffer-state nil
- ;; Temporarily reapply the string fence syntax-table properties.
- (c-with-extended-string-fences
- string-fence-beg (if c-in-after-change-fontification
- (max end c-new-END)
- end)
-
- (if (and c-in-after-change-fontification
- (< beg c-new-END) (> end c-new-BEG))
- ;; Region and the latest after-change fontification region overlap.
- ;; Determine the upper and lower bounds of our adjusted region
- ;; separately.
- (progn
- (if (<= beg c-new-BEG)
- (setq c-in-after-change-fontification nil))
- (setq new-beg
- (if (and (>= beg (c-point 'bol c-new-BEG))
- (<= beg c-new-BEG))
- ;; Either jit-lock has accepted `c-new-BEG', or has
- ;; (probably) extended the change region spuriously
- ;; to BOL, which position likely has a
- ;; syntactically different position. To ensure
- ;; correct fontification, we start at `c-new-BEG',
- ;; assuming any characters to the left of
- ;; `c-new-BEG' on the line do not require
- ;; fontification.
- c-new-BEG
- (setq new-region (c-before-context-fl-expand-region beg end)
- new-end (cdr new-region))
- (car new-region)))
- (setq new-end
- (if (and (>= end (c-point 'bol c-new-END))
- (<= end c-new-END))
- c-new-END
- (or new-end
- (cdr (c-before-context-fl-expand-region beg end))))))
- ;; Context (etc.) fontification.
- (setq new-region (c-before-context-fl-expand-region beg end)
- new-beg (car new-region) new-end (cdr new-region)))
- ;; Finally invoke font lock's functionality.
- (funcall (default-value 'font-lock-fontify-region-function)
- new-beg new-end verbose)))))))
+ (c-restore-string-fences)
+ (if (and c-in-after-change-fontification
+ (< beg c-new-END) (> end c-new-BEG))
+ ;; Region and the latest after-change fontification region overlap.
+ ;; Determine the upper and lower bounds of our adjusted region
+ ;; separately.
+ (progn
+ (if (<= beg c-new-BEG)
+ (setq c-in-after-change-fontification nil))
+ (setq new-beg
+ (if (and (>= beg (c-point 'bol c-new-BEG))
+ (<= beg c-new-BEG))
+ ;; Either jit-lock has accepted `c-new-BEG', or has
+ ;; (probably) extended the change region spuriously
+ ;; to BOL, which position likely has a
+ ;; syntactically different position. To ensure
+ ;; correct fontification, we start at `c-new-BEG',
+ ;; assuming any characters to the left of
+ ;; `c-new-BEG' on the line do not require
+ ;; fontification.
+ c-new-BEG
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-end (cdr new-region))
+ (car new-region)))
+ (setq new-end
+ (if (and (>= end (c-point 'bol c-new-END))
+ (<= end c-new-END))
+ c-new-END
+ (or new-end
+ (cdr (c-before-context-fl-expand-region beg end))))))
+ ;; Context (etc.) fontification.
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-beg (car new-region) new-end (cdr new-region)))
+ ;; Finally invoke font lock's functionality.
+ (funcall (default-value 'font-lock-fontify-region-function)
+ new-beg new-end verbose))
+ (c-clear-string-fences))))))
(defun c-after-font-lock-init ()
;; Put on `font-lock-mode-hook'. This function ensures our after-change
@@ -2444,11 +2532,6 @@ opening \" and the next unescaped end of line."
(funcall (c-lang-const c-make-mode-syntax-table c))
"Syntax table used in c-mode buffers.")
-(c-define-abbrev-table 'c-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0))
- "Abbreviation table used in c-mode buffers.")
-
(defvar c-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2521,13 +2604,21 @@ Key bindings:
(defconst c-or-c++-mode--regexp
(eval-when-compile
- (let ((id "[a-zA-Z0-9_]+") (ws "[ \t\r]+") (ws-maybe "[ \t\r]*"))
+ (let ((id "[a-zA-Z_][a-zA-Z0-9_]*") (ws "[ \t]+") (ws-maybe "[ \t]*")
+ (headers '("string" "string_view" "iostream" "map" "unordered_map"
+ "set" "unordered_set" "vector" "tuple")))
(concat "^" ws-maybe "\\(?:"
- "using" ws "\\(?:namespace" ws "std;\\|std::\\)"
- "\\|" "namespace" "\\(:?" ws id "\\)?" ws-maybe "{"
- "\\|" "class" ws id ws-maybe "[:{\n]"
- "\\|" "template" ws-maybe "<.*>"
- "\\|" "#include" ws-maybe "<\\(?:string\\|iostream\\|map\\)>"
+ "using" ws "\\(?:namespace" ws
+ "\\|" id "::"
+ "\\|" id ws-maybe "=\\)"
+ "\\|" "\\(?:inline" ws "\\)?namespace"
+ "\\(:?" ws "\\(?:" id "::\\)*" id "\\)?" ws-maybe "{"
+ "\\|" "class" ws id
+ "\\(?:" ws "final" "\\)?" ws-maybe "[:{;\n]"
+ "\\|" "struct" ws id "\\(?:" ws "final" ws-maybe "[:{\n]"
+ "\\|" ws-maybe ":\\)"
+ "\\|" "template" ws-maybe "<.*?>"
+ "\\|" "#include" ws-maybe "<" (regexp-opt headers) ">"
"\\)")))
"A regexp applied to C header files to check if they are really C++.")
@@ -2543,6 +2634,7 @@ should be used.
This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
`c-mode' or `c++-mode'."
+ (interactive)
(if (save-excursion
(save-restriction
(save-match-data
@@ -2560,12 +2652,6 @@ the code is C or C++ and based on that chooses whether to enable
(funcall (c-lang-const c-make-mode-syntax-table c++))
"Syntax table used in c++-mode buffers.")
-(c-define-abbrev-table 'c++-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0)
- ("catch" "catch" c-electric-continued-statement 0))
- "Abbreviation table used in c++-mode buffers.")
-
(defvar c++-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2614,11 +2700,6 @@ Key bindings:
(funcall (c-lang-const c-make-mode-syntax-table objc))
"Syntax table used in objc-mode buffers.")
-(c-define-abbrev-table 'objc-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0))
- "Abbreviation table used in objc-mode buffers.")
-
(defvar objc-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2665,13 +2746,6 @@ Key bindings:
(funcall (c-lang-const c-make-mode-syntax-table java))
"Syntax table used in java-mode buffers.")
-(c-define-abbrev-table 'java-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0)
- ("catch" "catch" c-electric-continued-statement 0)
- ("finally" "finally" c-electric-continued-statement 0))
- "Abbreviation table used in java-mode buffers.")
-
(defvar java-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2683,7 +2757,7 @@ Key bindings:
;; since it's practically impossible to write a regexp that reliably
;; matches such a construct. Other tools are necessary.
(defconst c-Java-defun-prompt-regexp
- "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*[][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()\^?=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f\v]*\\)+\\)?\\s-*")
+ "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()\^?=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f\v]*\\)+\\)?\\s-*")
(easy-menu-define c-java-menu java-mode-map "Java Mode Commands"
(cons "Java" (c-lang-const c-mode-menu java)))
@@ -2722,9 +2796,6 @@ Key bindings:
(funcall (c-lang-const c-make-mode-syntax-table idl))
"Syntax table used in idl-mode buffers.")
-(c-define-abbrev-table 'idl-mode-abbrev-table nil
- "Abbreviation table used in idl-mode buffers.")
-
(defvar idl-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2767,11 +2838,6 @@ Key bindings:
(funcall (c-lang-const c-make-mode-syntax-table pike))
"Syntax table used in pike-mode buffers.")
-(c-define-abbrev-table 'pike-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0))
- "Abbreviation table used in pike-mode buffers.")
-
(defvar pike-mode-map
(let ((map (c-make-inherited-keymap)))
map)
@@ -2819,11 +2885,6 @@ Key bindings:
;;;###autoload (add-to-list 'interpreter-mode-alist '("nawk" . awk-mode))
;;;###autoload (add-to-list 'interpreter-mode-alist '("gawk" . awk-mode))
-(c-define-abbrev-table 'awk-mode-abbrev-table
- '(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0))
- "Abbreviation table used in awk-mode buffers.")
-
(defvar awk-mode-map
(let ((map (c-make-inherited-keymap)))
map)
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index 36be9f6c74e..855e467571d 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -395,8 +395,7 @@ a null operation."
;; remain. This is not necessary for c-offsets-alist, since
;; c-get-style-variables contains every valid offset type in the
;; fallback entry.
- (setq c-special-indent-hook
- (default-value 'c-special-indent-hook)))
+ (kill-local-variable 'c-special-indent-hook))
(mapc (lambda (elem)
(c-set-style-1 elem dont-override))
;; Need to go through the variables backwards when we
@@ -644,7 +643,7 @@ CC Mode by making sure the proper entries are present on
(defun c-make-styles-buffer-local (&optional this-buf-only-p)
"Make all CC Mode style variables buffer local.
-If `this-buf-only-p' is non-nil, the style variables will be made
+If THIS-BUF-ONLY-P is non-nil, the style variables will be made
buffer local only in the current buffer. Otherwise they'll be made
permanently buffer local in any buffer that changes their values.
@@ -662,7 +661,6 @@ any reason to call this function directly."
;; Hooks must be handled specially
(if this-buf-only-p
(if (featurep 'xemacs) (make-local-hook 'c-special-indent-hook))
- (with-no-warnings (make-variable-buffer-local 'c-special-indent-hook))
(setq c-style-variables-are-local-p t))
))
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 556ff6059f1..9e6f9527ca1 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -576,6 +576,7 @@ comment styles:
javadoc -- Javadoc style for \"/** ... */\" comments (default in Java mode).
autodoc -- Pike autodoc style for \"//! ...\" comments (default in Pike mode).
gtkdoc -- GtkDoc style for \"/** ... **/\" comments (default in C and C++ modes).
+ doxygen -- Doxygen style.
The value may also be a list of doc comment styles, in which case all
of them are recognized simultaneously (presumably with markup cues
@@ -1649,6 +1650,15 @@ white space either before or after the operator, but not both."
:type 'boolean
:group 'c)
+(defcustom c-cpp-indent-to-body-directives '("pragma")
+ "Preprocessor directives which will be indented as statements.
+
+A list of Preprocessor directives which when reindented, or newly
+typed in, will cause the \"#\" introducing the directive to be
+indented as a statement."
+ :type '(repeat string)
+ :group 'c)
+
;; Initialize the next two to a regexp which never matches.
(defvar c-noise-macro-with-parens-name-re regexp-unmatchable)
(make-variable-buffer-local 'c-noise-macro-with-parens-name-re)
@@ -1660,7 +1670,8 @@ white space either before or after the operator, but not both."
like \"INLINE\" which are syntactic noise. Such a macro/extension is complete
in itself, never having parentheses. All these names must be syntactically
valid identifiers. Alternatively, this variable may be a regular expression
-which matches the names of such macros.
+which matches the names of such macros, in which case it must have a submatch
+1 which matches the actual noise macro name.
If you change this variable's value, call the function
`c-make-noise-macro-regexps' to set the necessary internal variables (or do
@@ -1676,7 +1687,8 @@ this implicitly by reinitializing C/C++/Objc Mode on any buffer)."
which optionally have arguments in parentheses, and which expand to nothing.
All these names must be syntactically valid identifiers. These are recognized
by CC Mode only in declarations. Alternatively, this variable may be a
-regular expression which matches the names of such macros.
+regular expression which matches the names of such macros, in which case it
+must have a submatch 1 which matches the actual noise macro name.
If you change this variable's value, call the function
`c-make-noise-macro-regexps' to set the necessary internal variables (or do
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 9ddb2ab2bbb..a8fe485b702 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -1294,10 +1294,10 @@ Calls `cfengine-cf-promises' with \"-s json\"."
'symbols))
syntax)))
-(defun cfengine3-documentation-function ()
+(defun cfengine3-documentation-function (&rest _ignored)
"Document CFengine 3 functions around point.
-Intended as the value of `eldoc-documentation-function', which see.
-Use it by enabling `eldoc-mode'."
+Intended as the value of `eldoc-documentation-functions', which
+see. Use it by enabling `eldoc-mode'."
(let ((fdef (cfengine3--current-function)))
(when fdef
(cfengine3-format-function-docstring fdef))))
@@ -1322,7 +1322,7 @@ Use it by enabling `eldoc-mode'."
(set (make-local-variable 'parens-require-spaces) nil)
(set (make-local-variable 'comment-start) "# ")
(set (make-local-variable 'comment-start-skip)
- "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
+ "\\(\\(?:^\\|[^\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
;; Like Lisp mode. Without this, we lose with, say,
;; `backward-up-list' when there's an unbalanced quote in a
;; preceding comment.
@@ -1390,12 +1390,8 @@ to the action header."
(when buffer-file-name
(shell-quote-argument buffer-file-name)))))
- ;; For emacs < 25.1 where `eldoc-documentation-function' defaults to
- ;; nil.
- (or eldoc-documentation-function
- (setq-local eldoc-documentation-function #'ignore))
- (add-function :before-until (local 'eldoc-documentation-function)
- #'cfengine3-documentation-function)
+ (add-hook 'eldoc-documentation-functions
+ #'cfengine3-documentation-function nil t)
(add-hook 'completion-at-point-functions
#'cfengine3-completion-function nil t)
diff --git a/lisp/progmodes/cl-font-lock.el b/lisp/progmodes/cl-font-lock.el
new file mode 100644
index 00000000000..cb6bd6c34bb
--- /dev/null
+++ b/lisp/progmodes/cl-font-lock.el
@@ -0,0 +1,290 @@
+;;; cl-font-lock.el --- Pretty Common Lisp font locking -*- lexical-binding: t; -*-
+;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+;; Author: Yue Daian <sheepduke@gmail.com>
+;; Maintainer: Spenser Truex <web@spensertruex.com>
+;; Created: 2019-06-16
+;; Old-Version: 0.3.0
+;; Package-Requires: ((emacs "24.5"))
+;; Keywords: lisp wp files convenience
+;; URL: https://github.com/cl-font-lock/cl-font-lock
+;; Homepage: https://github.com/cl-font-lock/cl-font-lock
+
+;; This file is part of GNU Emacs
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Highlight all the symbols in the Common Lisp ANSI Standard.
+;; Adds font-lock regexes to lisp-mode.
+
+;;;; Todo:
+
+;; - Integrate better into `lisp-mode' (e.g. enable it by default).
+;; - Distinguish functions from macros like `pushnew'.
+
+;;; Code:
+
+;; The list of built-in functions and variables was actually not
+;; extracted from the standard, but from SBCL with the following
+;; (Common Lisp) code:
+
+;; (defvar *functions* nil)
+;; (defvar *symbols* nil)
+;; (defvar *types* nil)
+
+;; (let ((pack (find-package :common-lisp)))
+;; (do-all-symbols (sym)
+;; (cond
+;; ((not (eql pack (symbol-package sym))) nil)
+;; ((fboundp sym) (pushnew sym *functions*))
+;; ((find-class sym nil) (pushnew sym *types*))
+;; (t (pushnew sym *symbols*)))))
+
+
+(defvar cl-font-lock-built-in--functions
+ '("+" "-" "/" "/=" "<" "<=" "=" ">" ">=" "*" "1-" "1+" "abs" "acons" "acos"
+ "acosh" "add-method" "adjoin" "adjustable-array-p" "adjust-array"
+ "allocate-instance" "alpha-char-p" "alphanumericp" "and" "append" "apply"
+ "apropos" "apropos-list" "aref" "arithmetic-error-operands"
+ "arithmetic-error-operation" "array-dimension" "array-dimensions"
+ "array-displacement" "array-element-type" "array-has-fill-pointer-p"
+ "array-in-bounds-p" "arrayp" "array-rank" "array-row-major-index"
+ "array-total-size" "ash" "asin" "asinh" "assoc" "assoc-if" "assoc-if-not"
+ "atan" "atanh" "atom" "bit" "bit-and" "bit-andc1" "bit-andc2" "bit-eqv"
+ "bit-ior" "bit-nand" "bit-nor" "bit-not" "bit-orc1" "bit-orc2"
+ "bit-vector-p" "bit-xor" "boole" "both-case-p" "boundp"
+ "broadcast-stream-streams" "butlast" "byte" "byte-position" "byte-size"
+ "call-method" "call-next-method" "car" "catch" "cdr" "ceiling"
+ "cell-error-name" "change-class" "char" "char/=" "char<" "char<=" "char="
+ "char>" "char>=" "character" "characterp" "char-code" "char-downcase"
+ "char-equal" "char-greaterp" "char-int" "char-lessp" "char-name"
+ "char-not-equal" "char-not-greaterp" "char-not-lessp" "char-upcase" "cis"
+ "class-name" "class-of" "clear-input" "clear-output" "close" "clrhash"
+ "code-char" "coerce" "compile" "compiled-function-p" "compile-file"
+ "compile-file-pathname" "compiler-macro-function" "complement" "complex"
+ "complexp" "compute-applicable-methods" "compute-restarts" "concatenate"
+ "concatenated-stream-streams" "conjugate" "cons" "consp" "constantly"
+ "constantp" "continue" "copy-alist" "copy-list" "copy-pprint-dispatch"
+ "copy-readtable" "copy-seq" "copy-structure" "copy-symbol" "copy-tree"
+ "cos" "cosh" "count" "count-if" "count-if-not" "decf" "decode-float"
+ "decode-universal-time" "delete" "delete-duplicates" "delete-file"
+ "delete-if" "delete-if-not" "delete-package" "denominator" "deposit-field"
+ "describe" "describe-object" "digit-char" "digit-char-p" "directory"
+ "directory-namestring" "disassemble" "do-all-symbols" "documentation"
+ "do-external-symbols" "do-symbols" "dpb" "dribble"
+ "echo-stream-input-stream" "echo-stream-output-stream" "ed" "eighth" "elt"
+ "encode-universal-time" "endp" "enough-namestring"
+ "ensure-directories-exist" "ensure-generic-function" "eq" "eql" "equal"
+ "equalp" "eval" "evenp" "every" "exp" "export" "expt" "fboundp" "fceiling"
+ "fdefinition" "ffloor" "fifth" "file-author" "file-error-pathname"
+ "file-length" "file-namestring" "file-position" "file-string-length"
+ "file-write-date" "fill" "fill-pointer" "find" "find-all-symbols"
+ "find-class" "find-if" "find-if-not" "find-method" "find-package"
+ "find-restart" "find-symbol" "finish-output" "first" "float" "float-digits"
+ "floatp" "float-precision" "float-radix" "float-sign" "floor" "fmakunbound"
+ "force-output" "format" "formatter" "fourth" "fresh-line" "fround"
+ "ftruncate" "funcall" "function" "function-keywords"
+ "function-lambda-expression" "functionp" "gcd" "gensym" "gentemp" "get"
+ "get-decoded-time" "get-dispatch-macro-character" "getf" "gethash"
+ "get-internal-real-time" "get-internal-run-time" "get-macro-character"
+ "get-output-stream-string" "get-properties" "get-setf-expansion"
+ "get-universal-time" "graphic-char-p" "hash-table-count" "hash-table-p"
+ "hash-table-rehash-size" "hash-table-rehash-threshold" "hash-table-size"
+ "hash-table-test" "host-namestring" "identity" "imagpart" "import" "incf"
+ "initialize-instance" "input-stream-p" "inspect" "integer-decode-float"
+ "integer-length" "integerp" "interactive-stream-p" "intern" "intersection"
+ "invalid-method-error" "invoke-debugger" "invoke-restart"
+ "invoke-restart-interactively" "isqrt" "keywordp" "last" "lcm" "ldb"
+ "ldb-test" "ldiff" "length" "lisp-implementation-type"
+ "lisp-implementation-version" "list" "list\\*" "list-all-packages" "listen"
+ "list-length" "listp" "load" "load-logical-pathname-translations"
+ "load-time-value" "log" "logand" "logandc1" "logandc2" "logbitp" "logcount"
+ "logeqv" "logical-pathname" "logical-pathname-translations" "logior"
+ "lognand" "lognor" "lognot" "logorc1" "logorc2" "logtest" "logxor"
+ "long-site-name" "loop-finish" "lower-case-p" "machine-instance"
+ "machine-type" "machine-version" "macroexpand" "macroexpand-1"
+ "macro-function" "make-array" "make-array" "make-broadcast-stream"
+ "make-concatenated-stream" "make-condition" "make-dispatch-macro-character"
+ "make-echo-stream" "make-hash-table" "make-instance"
+ "make-instances-obsolete" "make-list" "make-load-form"
+ "make-load-form-saving-slots" "make-method" "make-package" "make-pathname"
+ "make-random-state" "make-sequence" "make-string"
+ "make-string-input-stream" "make-string-output-stream" "make-symbol"
+ "make-synonym-stream" "make-two-way-stream" "makunbound" "map" "mapc"
+ "mapcan" "mapcar" "mapcon" "maphash" "map-into" "mapl" "maplist"
+ "mask-field" "max" "member" "member-if" "member-if-not" "merge"
+ "merge-pathnames" "method-combination-error" "method-qualifiers" "min"
+ "minusp" "mismatch" "mod" "muffle-warning" "multiple-value-call"
+ "multiple-value-list" "multiple-value-setq" "name-char" "namestring"
+ "nbutlast" "nconc" "next-method-p" "nintersection" "ninth"
+ "no-applicable-method" "no-next-method" "not" "notany" "notevery" "nreconc"
+ "nreverse" "nset-difference" "nset-exclusive-or" "nstring-capitalize"
+ "nstring-downcase" "nstring-upcase" "nsublis" "nsubst" "nsubst-if"
+ "nsubst-if-not" "nsubstitute" "nsubstitute-if" "nsubstitute-if-not" "nth"
+ "nthcdr" "nth-value" "null" "numberp" "numerator" "nunion" "oddp" "open"
+ "open-stream-p" "or" "output-stream-p" "package-error-package"
+ "package-name" "package-nicknames" "packagep" "package-shadowing-symbols"
+ "package-used-by-list" "package-use-list" "pairlis" "parse-integer"
+ "parse-namestring" "pathname" "pathname-device" "pathname-directory"
+ "pathname-host" "pathname-match-p" "pathname-name" "pathnamep"
+ "pathname-type" "pathname-version" "peek-char" "phase" "plusp" "pop"
+ "position" "position-if" "position-if-not" "pprint" "pprint-dispatch"
+ "pprint-exit-if-list-exhausted" "pprint-fill" "pprint-indent"
+ "pprint-linear" "pprint-logical-block" "pprint-newline" "pprint-pop"
+ "pprint-tab" "pprint-tabular" "prin1" "prin1-to-string" "princ"
+ "princ-to-string" "print" "print-not-readable-object" "print-object"
+ "print-unreadable-object" "probe-file" "provide" "psetf" "psetq" "push"
+ "pushnew" "quote" "random" "random-state-p" "rassoc" "rassoc-if"
+ "rassoc-if-not" "rational" "rationalize" "rationalp" "read" "read-byte"
+ "read-char" "read-char-no-hang" "read-delimited-list" "read-from-string"
+ "read-line" "read-preserving-whitespace" "read-sequence" "readtable-case"
+ "readtablep" "realp" "realpart" "reduce" "reinitialize-instance" "rem"
+ "remf" "remhash" "remove" "remove-duplicates" "remove-if" "remove-if-not"
+ "remove-method" "remprop" "rename-file" "rename-package" "replace"
+ "require" "rest" "restart-name" "revappend" "reverse" "room" "rotatef"
+ "round" "row-major-aref" "rplaca" "rplacd" "sbit" "scale-float" "schar"
+ "search" "second" "set" "set-difference" "set-dispatch-macro-character"
+ "set-exclusive-or" "setf" "set-macro-character" "set-pprint-dispatch"
+ "setq" "set-syntax-from-char" "seventh" "shadow" "shadowing-import"
+ "shared-initialize" "shiftf" "short-site-name" "signum"
+ "simple-bit-vector-p" "simple-condition-format-arguments"
+ "simple-condition-format-control" "simple-string-p" "simple-vector-p" "sin"
+ "sinh" "sixth" "sleep" "slot-boundp" "slot-exists-p" "slot-makunbound"
+ "slot-missing" "slot-unbound" "slot-value" "software-type"
+ "software-version" "some" "sort" "special-operator-p" "sqrt" "stable-sort"
+ "standard-char-p" "step" "store-value" "stream-element-type"
+ "stream-error-stream" "stream-external-format" "streamp" "string"
+ "string/=" "string<" "string<=" "string=" "string>" "string>="
+ "string-capitalize" "string-downcase" "string-equal" "string-greaterp"
+ "string-left-trim" "string-lessp" "string-not-equal" "string-not-greaterp"
+ "string-not-lessp" "stringp" "string-right-trim" "string-trim"
+ "string-upcase" "sublis" "subseq" "subsetp" "subst" "subst-if"
+ "subst-if-not" "substitute" "substitute-if" "substitute-if-not" "subtypep"
+ "svref" "sxhash" "symbol-function" "symbol-name" "symbolp" "symbol-package"
+ "symbol-plist" "symbol-value" "synonym-stream-symbol" "tailp" "tan" "tanh"
+ "tenth" "terpri" "third" "throw" "time" "trace"
+ "translate-logical-pathname" "translate-pathname" "tree-equal" "truename"
+ "truncate" "two-way-stream-input-stream" "two-way-stream-output-stream"
+ "type-error-datum" "type-error-expected-type" "type-of" "typep"
+ "unbound-slot-instance" "unexport" "unintern" "union" "unread-char"
+ "untrace" "unuse-package" "update-instance-for-different-class"
+ "update-instance-for-redefined-class" "upgraded-array-element-type"
+ "upgraded-complex-part-type" "upper-case-p" "use-package"
+ "user-homedir-pathname" "use-value" "values" "values-list" "vector"
+ "vectorp" "vector-pop" "vector-push" "vector-push-extend" "wild-pathname-p"
+ "write" "write-byte" "write-char" "write-line" "write-sequence"
+ "write-string" "write-to-string" "yes-or-no-p" "y-or-n-p" "zerop"))
+
+(defvar cl-font-lock-built-in--variables
+ '("//" "///" "\\*load-pathname\\*" "\\*print-pprint-dispatch\\*"
+ "\\*break-on-signals\\*" "\\*load-print\\*" "\\*print-pprint-dispatch\\*"
+ "\\*break-on-signals\\*" "\\*load-truename\\*" "\\*print-pretty\\*"
+ "\\*load-verbose\\*" "\\*print-radix\\*" "\\*compile-file-pathname\\*"
+ "\\*macroexpand-hook\\*" "\\*print-readably\\*"
+ "\\*compile-file-pathname\\*" "\\*modules\\*" "\\*print-right-margin\\*"
+ "\\*compile-file-truename\\*" "\\*package\\*" "\\*print-right-margin\\*"
+ "\\*compile-file-truename\\*" "\\*print-array\\*" "\\*query-io\\*"
+ "\\*compile-print\\*" "\\*print-base\\*" "\\*random-state\\*"
+ "\\*compile-verbose\\*" "\\*default-pathname-defaults\\*"
+ "\\*print-length\\*" "\\*readtable\\*" "\\*error-output\\*"
+ "\\*print-level\\*" "\\*standard-input\\*" "\\*print-case\\*"
+ "\\*read-base\\*" "\\*compile-verbose\\*" "\\*print-circle\\*"
+ "\\*print-lines\\*" "\\*standard-output\\*" "\\*features\\*"
+ "\\*print-miser-width\\*" "\\*read-default-float-format\\*"
+ "\\*debug-io\\*" "\\*print-escape\\*" "\\*read-eval\\*"
+ "\\*debugger-hook\\*" "\\*print-gensym\\*" "\\*read-suppress\\*"
+ "\\*terminal-io\\*" "\\*gensym-counter\\*" "\\*print-miser-width\\*"
+ "\\*trace-output\\*" "array-dimension-limit" "array-rank-limit"
+ "array-total-size-limit" "boole-1" "boole-2" "boole-and" "boole-andc1"
+ "boole-andc2" "boole-c1" "boole-c2" "boole-clr" "boole-eqv" "boole-ior"
+ "boole-nand" "boole-nor" "boole-orc1" "boole-orc2" "boole-set" "boole-xor"
+ "call-arguments-limit" "char-code-limit" "double-float-epsilon"
+ "double-float-negative-epsilon" "internal-time-units-per-second"
+ "lambda-list-keywords" "lambda-parameters-limit"
+ "least-negative-double-float" "least-negative-long-float"
+ "least-negative-normalized-double-float"
+ "least-negative-normalized-long-float"
+ "least-negative-normalized-short-float"
+ "least-negative-normalized-single-float" "least-negative-short-float"
+ "least-negative-single-float" "least-positive-double-float"
+ "least-positive-long-float" "least-positive-normalized-double-float"
+ "least-positive-normalized-long-float"
+ "least-positive-normalized-short-float"
+ "least-positive-normalized-single-float" "least-positive-short-float"
+ "least-positive-single-float" "long-float-epsilon"
+ "long-float-negative-epsilon" "most-negative-double-float"
+ "most-negative-fixnum" "most-negative-long-float"
+ "most-negative-short-float" "most-negative-single-float"
+ "most-positive-double-float" "most-positive-fixnum"
+ "most-positive-long-float" "most-positive-short-float"
+ "most-positive-single-float" "multiple-values-limit" "short-float-epsilon"
+ "short-float-negative-epsilon" "single-float-epsilon"
+ "single-float-negative-epsilon" "pi"))
+
+(defvar cl-font-lock-built-in--types
+ '("arithmetic-error" "array" "base-char" "base-string" "bignum" "bit-vector"
+ "boolean" "broadcast-stream" "built-in-class" "cell-error" "class"
+ "compiled-function" "concatenated-stream" "condition" "control-error"
+ "division-by-zero" "double-float" "echo-stream" "end-of-file"
+ "extended-char" "file-error" "file-stream" "fixnum"
+ "floating-point-inexact" "floating-point-invalid-operation"
+ "floating-point-overflow" "floating-point-underflow" "generic-function"
+ "hash-table" "integer" "keyword" "long-float" "method" "method-combination"
+ "number" "package" "package-error" "parse-error" "print-not-readable"
+ "program-error" "random-state" "ratio" "reader-error" "readtable" "real"
+ "restart" "sequence" "serious-condition" "short-float" "signed-byte"
+ "simple-array" "simple-base-string" "simple-bit-vector" "simple-condition"
+ "simple-error" "simple-string" "simple-type-error" "simple-vector"
+ "simple-warning" "single-float" "standard-char" "standard-class"
+ "standard-generic-function" "standard-method" "standard-object"
+ "storage-condition" "stream" "stream-error" "string-stream"
+ "structure-class" "structure-object" "style-warning" "symbol"
+ "synonym-stream" "two-way-stream" "type-error" "unbound-slot"
+ "unbound-variable" "undefined-function" "unsigned-byte" "warning"))
+
+(defvar cl-font-lock-built-in--symbols
+ '("compilation-speed" "compiler-macro" "debug" "declaration" "dynamic-extent"
+ "ftype" "ignorable" "ignore" "inline" "notinline" "optimize" "otherwise"
+ "safety" "satisfies" "space" "special" "speed" "structure" "type"))
+
+(defvar cl-font-lock--character-names
+ '("newline" "space" "rubout" "page" "tab" "backspace" "return" "linefeed"))
+
+(defvar cl-font-lock-built-in-keywords
+ (mapcar (lambda (s)
+ `(,(regexp-opt (symbol-value (car s)) 'symbols)
+ . ,(cdr s)))
+ '((cl-font-lock-built-in--functions . font-lock-function-name-face)
+ (cl-font-lock-built-in--variables . font-lock-variable-name-face)
+ (cl-font-lock-built-in--types . font-lock-type-face)
+ (cl-font-lock-built-in--symbols . font-lock-builtin-face)
+ (cl-font-lock--character-names . font-lock-variable-name-face))))
+
+;;;###autoload
+(define-minor-mode cl-font-lock-built-in-mode
+ "Highlight built-in functions, variables, and types in `lisp-mode'."
+ :global t
+ :group 'tools
+ (funcall
+ (if cl-font-lock-built-in-mode
+ #'font-lock-add-keywords
+ #'font-lock-remove-keywords)
+ 'lisp-mode
+ cl-font-lock-built-in-keywords))
+
+(provide 'cl-font-lock)
+
+;;; cl-font-lock.el ends here
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 455f181f501..de9c9a209d1 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -33,6 +33,7 @@
(eval-when-compile (require 'cl-lib))
(require 'tool-bar)
(require 'comint)
+(require 'text-property-search)
(defgroup compilation nil
"Run compiler as inferior of Emacs, parse error messages."
@@ -64,7 +65,8 @@ If nil, use Emacs default."
If the replacement is nil, the file will not be considered an
error after all. If not nil, it should be a regexp replacement
string."
- :type '(repeat (list regexp string))
+ :type '(repeat (list regexp (choice (const :tag "No replacement" nil)
+ string)))
:version "27.1")
(defvar compilation-filter-hook nil
@@ -221,9 +223,9 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; considered before EDG.
;; The message may be a "warning", "error", or "fatal error" with
;; an error code, or "see declaration of" without an error code.
- "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^ :(\t\n][^:(\t\n]*\\)(\\([0-9]+\\)) ?\
+ "^ *\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^ :(\t\n][^:(\t\n]*\\)(\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?) ?\
: \\(?:see declaration\\|\\(?:warnin\\(g\\)\\|[a-z ]+\\) C[0-9]+:\\)"
- 2 3 nil (4))
+ 2 3 4 (5))
(edg-1
"^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
@@ -265,6 +267,23 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(java
"^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))
+ (javac
+ ,(rx bol
+ (group ; file
+ (? (in "A-Za-z") ":")
+ (+ (not (in "\n:"))))
+ ":"
+ (group (+ (in "0-9"))) ; line number
+ ": "
+ (? (group "warning: ")) ; type (optional)
+ (* nonl) "\n" ; message
+ (* nonl) "\n" ; source line containing error
+ (* " ") "^" ; caret line; ^ marks error
+ eol)
+ 1 2
+ ,#'current-column
+ (3))
+
(jikes-file
"^\\(?:Found\\|Issued\\) .* compiling \"\\(.+\\)\":$" 1 nil nil 0)
@@ -302,8 +321,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(gcc-include
"^\\(?:In file included \\| \\|\t\\)from \
\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\
-\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?"
- 1 2 3 (4 . 5))
+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\(?:\\([:,]\\|$\\)\\)?"
+ 1 2 3 (nil . 4))
(ruby-Test::Unit
"^ [[ ]?\\([^ (].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2)
@@ -315,48 +334,44 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
": \\*\\*\\* \\[\\(\\(.+?\\):\\([0-9]+\\): .+\\)\\]" 2 3 nil 0 1)
(gnu
- ;; The first line matches the program name for
-
- ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
-
- ;; format, which is used for non-interactive programs other than
- ;; compilers (e.g. the "jade:" entry in compilation.txt).
-
- ;; This first line makes things ambiguous with output such as
- ;; "foo:344:50:blabla" since the "foo" part can match this first
- ;; line (in which case the file name as "344"). To avoid this,
- ;; the second line disallows filenames exclusively composed of
- ;; digits.
-
- ;; Similarly, we get lots of false positives with messages including
- ;; times of the form "HH:MM:SS" where MM is taken as a line number, so
- ;; the last line tries to rule out message where the info after the
- ;; line number starts with "SS". --Stef
-
- ;; The core of the regexp is the one with *?. It says that a file name
- ;; can be composed of any non-newline char, but it also rules out some
- ;; valid but unlikely cases, such as a trailing space or a space
- ;; followed by a -, or a colon followed by a space.
- ;;
- ;; The "in \\|from " exception was added to handle messages from Ruby.
,(rx
bol
+ ;; Match an optional program name in the format
+ ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE
+ ;; which is used for non-interactive programs other than
+ ;; compilers (e.g. the "jade:" entry in compilation.txt).
(? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?")
+ ;; FIXME: This pattern was added for handling messages
+ ;; from Ruby, but it is unclear whether it is actually
+ ;; used since the gcc-include rule above seems to cover
+ ;; it.
(regexp "[ \t]+\\(?:in \\|from\\)")))
- (group-n 1 (: (regexp "[0-9]*[^0-9\n]")
- (*? (| (regexp "[^\n :]")
- (regexp " [^-/\n]")
- (regexp ":[^ \n]")))))
+
+ ;; File name group.
+ (group-n 1
+ ;; Avoid matching the file name as a program in the pattern
+ ;; above by disallow file names entirely composed of digits.
+ (: (regexp "[0-9]*[^0-9\n]")
+ ;; This rule says that a file name can be composed
+ ;; of any non-newline char, but it also rules out
+ ;; some valid but unlikely cases, such as a
+ ;; trailing space or a space followed by a -, or a
+ ;; colon followed by a space.
+ (*? (| (regexp "[^\n :]")
+ (regexp " [^-/\n]")
+ (regexp ":[^ \n]")))))
(regexp ": ?")
+
+ ;; Line number group.
(group-n 2 (regexp "[0-9]+"))
(? (| (: "-"
- (group-n 4 (regexp "[0-9]+"))
- (? "." (group-n 5 (regexp "[0-9]+"))))
+ (group-n 4 (regexp "[0-9]+")) ; ending line
+ (? "." (group-n 5 (regexp "[0-9]+")))) ; ending column
(: (in ".:")
- (group-n 3 (regexp "[0-9]+"))
+ (group-n 3 (regexp "[0-9]+")) ; starting column
(? "-"
- (? (group-n 4 (regexp "[0-9]+")) ".")
- (group-n 5 (regexp "[0-9]+"))))))
+ (? (group-n 4 (regexp "[0-9]+")) ".") ; ending line
+ (group-n 5 (regexp "[0-9]+")))))) ; ending column
":"
(| (: (* " ")
(group-n 6 (| "FutureWarning"
@@ -373,6 +388,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(regexp "[Nn]ote"))))
(: (* " ")
(regexp "[Ee]rror"))
+
+ ;; Avoid matching time stamps on the form "HH:MM:SS" where
+ ;; MM is interpreted as a line number by trying to rule out
+ ;; messages where the text after the line number starts with
+ ;; a 2-digit number.
(: (regexp "[0-9]?")
(| (regexp "[^0-9\n]")
eol))
@@ -435,6 +455,9 @@ during global destruction\\.$\\)" 1 2)
\\([0-9]+\\) of file://\\(.+\\)"
4 2 3 (1))
+ (shellcheck
+ "^In \\(.+\\) line \\([0-9]+\\):" 1 2)
+
(sparc-pascal-file
"^\\w\\w\\w \\w\\w\\w +[0-3]?[0-9] +[0-2][0-9]:[0-5][0-9]:[0-5][0-9]\
[12][09][0-9][0-9] +\\(.*\\):$"
@@ -646,6 +669,16 @@ matched file names, and weeding out false positives."
:link `(file-link :tag "example file"
,(expand-file-name "compilation.txt" data-directory)))
+(defvar compilation-error-case-fold-search nil
+ "If non-nil, use case-insensitive matching of compilation errors
+by the regexps of `compilation-error-regexp-alist' and
+`compilation-error-regexp-alist-alist'.
+If nil, matching is case-sensitive.
+
+This variable should only be set for backward compatibility as a temporary
+measure. The proper solution is to use a regexp that matches the
+messages without case-folding.")
+
;;;###autoload(put 'compilation-directory 'safe-local-variable 'stringp)
(defvar compilation-directory nil
"Directory to restore to when doing `recompile'.")
@@ -716,6 +749,18 @@ variable, and you might not notice. Therefore, `compile-command'
is considered unsafe if this variable is nil."
:type 'boolean)
+(defcustom compilation-search-all-directories t
+ "Whether further upward directories should be used when searching a file.
+When doing a parallel build, several files from different
+directories can be compiled at the same time. This makes it
+difficult to determine the base directory for a relative file
+name in a compiler error or warning. If this variable is
+non-nil, instead of just relying on the previous directory change
+in the compilation buffer, all other directories further upwards
+will be used as well."
+ :type 'boolean
+ :version "28.1")
+
;;;###autoload
(defcustom compilation-ask-about-save t
"Non-nil means \\[compile] asks which buffers to save before compiling.
@@ -1022,9 +1067,9 @@ from a different message."
(:constructor nil)
(:copier nil)
;; (:type list) ;Old representation.
- (:constructor compilation--make-message (loc type end-loc))
+ (:constructor compilation--make-message (loc type end-loc rule))
(:conc-name compilation--message->))
- loc type end-loc)
+ loc type end-loc rule)
(defvar compilation--previous-directory-cache nil
"A pair (POS . RES) caching the result of previous directory search.
@@ -1097,7 +1142,7 @@ POS and RES.")
(cons (match-string-no-properties idx) dir))
;; Place a `compilation-message' everywhere we change text-properties
;; so compilation--remove-properties can know what to remove.
- compilation-message ,(compilation--make-message nil 0 nil)
+ compilation-message ,(compilation--make-message nil 0 nil nil)
mouse-face highlight
keymap compilation-button-map
help-echo "mouse-2: visit destination directory")))
@@ -1124,18 +1169,20 @@ POS and RES.")
(setcdr l1 (cons (list ,key) l2)))))))
(defun compilation-auto-jump (buffer pos)
- (with-current-buffer buffer
- (goto-char pos)
- (let ((win (get-buffer-window buffer 0)))
- (if win (set-window-point win pos)))
- (if compilation-auto-jump-to-first-error
- (compile-goto-error))))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (goto-char pos)
+ (let ((win (get-buffer-window buffer 0)))
+ (if win (set-window-point win pos)))
+ (if compilation-auto-jump-to-first-error
+ (compile-goto-error)))))
;; This function is the central driver, called when font-locking to gather
;; all information needed to later jump to corresponding source code.
;; Return a property list with all meta information on this error location.
-(defun compilation-error-properties (file line end-line col end-col type fmt)
+(defun compilation-error-properties (file line end-line col end-col type fmt
+ rule)
(unless (text-property-not-all (match-beginning 0) (point)
'compilation-message nil)
(if file
@@ -1199,12 +1246,12 @@ POS and RES.")
2)))
;; Remove matches like /bin/sh and do other file name transforms.
(save-match-data
- (let ((file-name
- (and (consp file)
- (not (bufferp (car file)))
- (if (cdr file)
- (expand-file-name (car file) (cdr file))
- (car file)))))
+ (when-let ((file-name
+ (and (consp file)
+ (not (bufferp (car file)))
+ (if (cdr file)
+ (expand-file-name (car file) (cdr file))
+ (car file)))))
(cl-loop for (regexp replacement)
in compilation-transform-file-match-alist
when (string-match regexp file-name)
@@ -1223,7 +1270,7 @@ POS and RES.")
(current-buffer) (match-beginning 0)))
(compilation-internal-error-properties
- file line end-line col end-col type fmt))))
+ file line end-line col end-col type fmt rule))))
(defun compilation-beginning-of-line (&optional n)
"Like `beginning-of-line', but accounts for lines hidden by `selective-display'."
@@ -1246,13 +1293,15 @@ just char-counts."
(let ((tab-width 8)) (move-to-column (max col 0)))
(goto-char (min (+ (line-beginning-position) col) (line-end-position)))))
-(defun compilation-internal-error-properties (file line end-line col end-col type fmts)
+(defun compilation-internal-error-properties (file line end-line col end-col
+ type fmts rule)
"Get the meta-info that will be added as text-properties.
LINE, END-LINE, COL, END-COL are integers or nil.
TYPE can be 0, 1, or 2, meaning error, warning, or just info.
FILE should be (FILENAME) or (RELATIVE-FILENAME . DIRNAME) or (BUFFER) or
nil.
FMTS is a list of format specs for transforming the file name.
+RULE is the name (symbol) of the rule used or nil if anonymous.
(See `compilation-error-regexp-alist'.)"
(unless file (setq file '("*unknown*")))
(let* ((file-struct (compilation-get-file-structure file fmts))
@@ -1339,7 +1388,7 @@ FMTS is a list of format specs for transforming the file name.
;; Must start with face
`(font-lock-face ,compilation-message-face
- compilation-message ,(compilation--make-message loc type end-loc)
+ compilation-message ,(compilation--make-message loc type end-loc rule)
help-echo ,(if col
"mouse-2: visit this file, line and column"
(if line
@@ -1431,98 +1480,109 @@ This updates the appropriate variable used by the mode-line."
"Parse errors between START and END.
The errors recognized are the ones specified in RULES which default
to `compilation-error-regexp-alist' if RULES is nil."
- (dolist (item (or rules compilation-error-regexp-alist))
- (if (symbolp item)
- (setq item (cdr (assq item
- compilation-error-regexp-alist-alist))))
- (let ((file (nth 1 item))
- (line (nth 2 item))
- (col (nth 3 item))
- (type (nth 4 item))
- (pat (car item))
- end-line end-col fmt
- props)
-
- ;; omake reports some error indented, so skip the indentation.
- ;; another solution is to modify (some?) regexps in
- ;; `compilation-error-regexp-alist'.
- ;; note that omake usage is not limited to ocaml and C (for stubs).
- ;; FIXME-omake: Doing it here seems wrong, at least it should depend on
- ;; whether or not omake's own error messages are recognized.
- (cond
- ((not (memq 'omake compilation-error-regexp-alist)) nil)
- ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat)
- nil) ;; Not anchored or anchored but already allows empty spaces.
- (t (setq pat (concat "^\\(?: \\)?" (substring pat 1)))))
-
- (if (consp file) (setq fmt (cdr file) file (car file)))
- (if (consp line) (setq end-line (cdr line) line (car line)))
- (if (consp col) (setq end-col (cdr col) col (car col)))
-
- (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
- (error "HYPERLINK should be an integer: %s" (nth 5 item)))
-
- (goto-char start)
- (while (re-search-forward pat end t)
- (when (setq props (compilation-error-properties
- file line end-line col end-col (or type 2) fmt))
-
- (when (integerp file)
- (let ((this-type (if (consp type)
- (compilation-type type)
- (or type 2))))
- (compilation--note-type this-type)
-
- (compilation--put-prop
- file 'font-lock-face
- (symbol-value (aref [compilation-info-face
- compilation-warning-face
- compilation-error-face]
- this-type)))))
-
- (compilation--put-prop
- line 'font-lock-face compilation-line-face)
- (compilation--put-prop
- end-line 'font-lock-face compilation-line-face)
-
- (compilation--put-prop
- col 'font-lock-face compilation-column-face)
- (compilation--put-prop
- end-col 'font-lock-face compilation-column-face)
-
- ;; Obey HIGHLIGHT.
- (dolist (extra-item (nthcdr 6 item))
- (let ((mn (pop extra-item)))
- (when (match-beginning mn)
- (let ((face (eval (car extra-item))))
- (cond
- ((null face))
- ((or (symbolp face) (stringp face))
- (put-text-property
- (match-beginning mn) (match-end mn)
- 'font-lock-face face))
- ((and (listp face)
- (eq (car face) 'face)
- (or (symbolp (cadr face))
- (stringp (cadr face))))
- (compilation--put-prop mn 'font-lock-face (cadr face))
- (add-text-properties
- (match-beginning mn) (match-end mn)
- (nthcdr 2 face)))
- (t
- (error "Don't know how to handle face %S"
- face)))))))
- (let ((mn (or (nth 5 item) 0)))
- (when compilation-debug
+ (let ((case-fold-search compilation-error-case-fold-search)
+ (omake-included (memq 'omake compilation-error-regexp-alist)))
+ (dolist (rule-item (or rules compilation-error-regexp-alist))
+ (let* ((item
+ (if (symbolp rule-item)
+ (cdr (assq rule-item compilation-error-regexp-alist-alist))
+ rule-item))
+ (pat (car item))
+ (file (nth 1 item))
+ (line (nth 2 item))
+ (col (nth 3 item))
+ (type (nth 4 item))
+ (rule (and (symbolp rule-item) rule-item))
+ end-line end-col fmt
+ props)
+
+ ;; omake reports some error indented, so skip the indentation.
+ ;; another solution is to modify (some?) regexps in
+ ;; `compilation-error-regexp-alist'.
+ ;; note that omake usage is not limited to ocaml and C (for stubs).
+ ;; FIXME-omake: Doing it here seems wrong, at least it should depend on
+ ;; whether or not omake's own error messages are recognized.
+ (cond
+ ((not omake-included) nil)
+ ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat)
+ nil) ;; Not anchored or anchored but already allows empty spaces.
+ (t (setq pat (concat "^\\(?: \\)?" (substring pat 1)))))
+
+ (if (and (consp file) (not (functionp file)))
+ (setq fmt (cdr file)
+ file (car file)))
+ (if (and (consp line) (not (functionp line)))
+ (setq end-line (cdr line)
+ line (car line)))
+ (if (and (consp col) (not (functionp col)))
+ (setq end-col (cdr col)
+ col (car col)))
+
+ (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
+ (error "HYPERLINK should be an integer: %s" (nth 5 item)))
+
+ (goto-char start)
+ (while (re-search-forward pat end t)
+ (when (setq props (compilation-error-properties
+ file line end-line col end-col
+ (or type 2) fmt rule))
+
+ (when (integerp file)
+ (let ((this-type (if (consp type)
+ (compilation-type type)
+ (or type 2))))
+ (compilation--note-type this-type)
+
+ (compilation--put-prop
+ file 'font-lock-face
+ (symbol-value (aref [compilation-info-face
+ compilation-warning-face
+ compilation-error-face]
+ this-type)))))
+
+ (compilation--put-prop
+ line 'font-lock-face compilation-line-face)
+ (compilation--put-prop
+ end-line 'font-lock-face compilation-line-face)
+
+ (compilation--put-prop
+ col 'font-lock-face compilation-column-face)
+ (compilation--put-prop
+ end-col 'font-lock-face compilation-column-face)
+
+ ;; Obey HIGHLIGHT.
+ (dolist (extra-item (nthcdr 6 item))
+ (let ((mn (pop extra-item)))
+ (when (match-beginning mn)
+ (let ((face (eval (car extra-item))))
+ (cond
+ ((null face))
+ ((or (symbolp face) (stringp face))
+ (put-text-property
+ (match-beginning mn) (match-end mn)
+ 'font-lock-face face))
+ ((and (listp face)
+ (eq (car face) 'face)
+ (or (symbolp (cadr face))
+ (stringp (cadr face))))
+ (compilation--put-prop mn 'font-lock-face (cadr face))
+ (add-text-properties
+ (match-beginning mn) (match-end mn)
+ (nthcdr 2 face)))
+ (t
+ (error "Don't know how to handle face %S"
+ face)))))))
+ (let ((mn (or (nth 5 item) 0)))
+ (when compilation-debug
+ (font-lock-append-text-property
+ (match-beginning 0) (match-end 0)
+ 'compilation-debug (vector 'std item props)))
+ (add-text-properties
+ (match-beginning mn) (match-end mn)
+ (cddr props))
(font-lock-append-text-property
- (match-beginning 0) (match-end 0)
- 'compilation-debug (vector 'std item props)))
- (add-text-properties
- (match-beginning mn) (match-end mn)
- (cddr props))
- (font-lock-append-text-property
- (match-beginning mn) (match-end mn)
- 'font-lock-face (cadr props))))))))
+ (match-beginning mn) (match-end mn)
+ 'font-lock-face (cadr props)))))))))
(defvar compilation--parsed -1)
(make-variable-buffer-local 'compilation--parsed)
@@ -1537,7 +1597,14 @@ to `compilation-error-regexp-alist' if RULES is nil."
;; grep.el) don't need to flush-parse when they modify the buffer
;; in a way that impacts buffer positions but does not require
;; re-parsing.
- (setq compilation--parsed (point-min-marker)))
+ (setq compilation--parsed
+ (set-marker (make-marker)
+ (save-excursion
+ (goto-char (point-min))
+ (text-property-search-forward 'compilation-header-end)
+ ;; If we have no end marker, this will be
+ ;; `point-min' still.
+ (point)))))
(when (< compilation--parsed limit)
(let ((start (max compilation--parsed (point-min))))
(move-marker compilation--parsed limit)
@@ -1782,6 +1849,9 @@ Returns the compilation buffer created."
mode-name
(substring (current-time-string) 0 19))
command "\n")
+ ;; Mark the end of the header so that we don't interpret
+ ;; anything in it as an error.
+ (put-text-property (1- (point)) (point) 'compilation-header-end t)
(setq thisdir default-directory))
(set-buffer-modified-p nil))
;; Pop up the compilation buffer.
@@ -2033,6 +2103,8 @@ Returns the compilation buffer created."
(define-key map "\M-p" 'compilation-previous-error)
(define-key map "\M-{" 'compilation-previous-file)
(define-key map "\M-}" 'compilation-next-file)
+ (define-key map "n" 'next-error-no-select)
+ (define-key map "p" 'previous-error-no-select)
(define-key map "\t" 'compilation-next-error)
(define-key map [backtab] 'compilation-previous-error)
(define-key map "g" 'recompile) ; revert
@@ -2056,8 +2128,7 @@ Returns the compilation buffer created."
'(menu-item "Compile..." compile
:help "Compile the program including the current buffer. Default: run `make'"))
map)
- "Keymap for compilation log buffers.
-`compilation-minor-mode-map' is a parent of this.")
+ "Keymap for compilation log buffers.")
(defvar compilation-mode-tool-bar-map
;; When bootstrapping, tool-bar-map is not properly initialized yet,
@@ -2342,12 +2413,10 @@ and runs `compilation-filter-hook'."
(set-marker min nil)
(set-marker max nil))))))
-;;; test if a buffer is a compilation buffer, assuming we're in the buffer
(defsubst compilation-buffer-internal-p ()
"Test if inside a compilation buffer."
(local-variable-p 'compilation-locs))
-;;; test if a buffer is a compilation buffer, using compilation-buffer-internal-p
(defsubst compilation-buffer-p (buffer)
"Test if BUFFER is a compilation buffer."
(with-current-buffer buffer
@@ -2388,12 +2457,9 @@ and runs `compilation-filter-hook'."
&optional object limit)
(let (parsed res)
(while (progn
- ;; We parse the buffer here "on-demand" by chunks of 500 chars.
- ;; But we could also just parse the whole buffer.
(compilation--ensure-parse
(setq parsed (max compilation--parsed
- (min (+ position 500)
- (or limit (point-max))))))
+ (or limit (point-max)))))
(and (or (not (setq res (next-single-property-change
position prop object limit)))
(eq res limit))
@@ -2873,6 +2939,28 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
(find-file-noselect name))
fmts (cdr fmts)))
(setq dirs (cdr dirs)))
+ ;; If we haven't found it, this might be a parallel build.
+ ;; Search the directories further up the buffer.
+ (when (and (null buffer)
+ compilation-search-all-directories)
+ (with-current-buffer (marker-buffer marker)
+ (save-excursion
+ (goto-char (marker-position marker))
+ (when-let ((prev (compilation--previous-directory (point))))
+ (goto-char prev))
+ (setq dirs (cdr (or (get-text-property
+ (1- (point)) 'compilation-directory)
+ (get-text-property
+ (point) 'compilation-directory))))))
+ (while (and dirs (null buffer))
+ (setq thisdir (car dirs)
+ fmts formats)
+ (while (and fmts (null buffer))
+ (setq name (expand-file-name (format (car fmts) filename) thisdir)
+ buffer (and (file-exists-p name)
+ (find-file-noselect name))
+ fmts (cdr fmts)))
+ (setq dirs (cdr dirs))))
(while (null buffer) ;Repeat until the user selects an existing file.
;; The file doesn't exist. Ask the user where to find it.
(save-excursion ;This save-excursion is probably not right.
@@ -2884,11 +2972,8 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
(and w (progn (compilation-set-window w marker)
(compilation-set-overlay-arrow w))))
(let* ((name (read-file-name
- (format "Find this %s in%s: "
- compilation-error
- (if filename
- (format " (default %s)" filename)
- ""))
+ (format-prompt "Find this %s in"
+ filename compilation-error)
spec-dir filename t nil
;; The predicate below is fine when called from
;; minibuffer-complete-and-exit, but it's too
@@ -3039,7 +3124,7 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given."
;; 'font-lock-face 'font-lock-warning-face)
(put-text-property src (line-end-position)
'compilation-message
- (compilation--make-message loc 2 nil)))))))
+ (compilation--make-message loc 2 nil nil)))))))
(goto-char limit)
nil)
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 5fee2df5863..a42ace105aa 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -7,6 +7,7 @@
;; Jonathan Rockway <jon@jrock.us>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, Perl
+;; Package-Requires: ((emacs "26.1"))
;; This file is part of GNU Emacs.
@@ -32,7 +33,7 @@
;; support.
;; The latest version is available from
-;; http://github.com/jrockway/cperl-mode
+;; https://github.com/jrockway/cperl-mode
;;
;; (perhaps in the moosex-declare branch)
@@ -47,6 +48,10 @@
;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<<
;; or as help on variables `cperl-tips', `cperl-problems', <<<<<<
;; `cperl-praise', `cperl-speed'. <<<<<<
+;;
+;; Or search for "Short extra-docs" further down in this file for
+;; details on how to use `cperl-mode' instead of `perl-mode' and lots
+;; of other details.
;; The mode information (on C-h m) provides some customization help.
;; If you use font-lock feature of this mode, it is advisable to use
@@ -66,15 +71,28 @@
;; (define-key global-map [M-S-down-mouse-3] 'imenu)
-;;;; Font lock bugs as of v4.32:
-
-;; The following kinds of Perl code erroneously start strings:
-;; \$` \$' \$"
-;; $opt::s $opt_s $opt{s} (s => ...) /\s+.../
-;; likewise with m, tr, y, q, qX instead of s
-
;;; Code:
+;;; Compatibility with older versions (for publishing on ELPA)
+;; The following helpers allow cperl-mode.el to work with older
+;; versions of Emacs.
+;;
+;; Whenever the minimum version is bumped (see "Package-Requires"
+;; above), please eliminate the corresponding compatibility-helpers.
+;; Whenever you create a new compatibility-helper, please add it here.
+
+;; Available in Emacs 27.1: time-convert
+(defalias 'cperl--time-convert
+ (if (fboundp 'time-convert) 'time-convert
+ 'encode-time))
+
+;; Available in Emacs 28: format-prompt
+(defalias 'cperl--format-prompt
+ (if (fboundp 'format-prompt) 'format-prompt
+ (lambda (msg default)
+ (if default (format "%s (default %s): " msg default)
+ (concat msg ": ")))))
+
(eval-when-compile (require 'cl-lib))
(defvar msb-menu-cond)
@@ -82,13 +100,6 @@
(defvar vc-rcs-header)
(defvar vc-sccs-header)
-(defmacro cperl-force-face (arg descr) ; Takes unquoted arg
- `(progn
- (or (facep (quote ,arg))
- (make-face ,arg))
- (or (boundp (quote ,arg)) ; We use unquoted variants too
- (defvar ,arg (quote ,arg) ,descr))))
-
(defun cperl-choose-color (&rest list)
(let (answer)
(while list
@@ -451,8 +462,7 @@ Older version of this page was called `perl5', newer `perl'."
:type 'string
:group 'cperl-help-system)
-(defcustom cperl-use-syntax-table-text-property
- (boundp 'parse-sexp-lookup-properties)
+(defcustom cperl-use-syntax-table-text-property t
"Non-nil means CPerl sets up and uses `syntax-table' text property."
:type 'boolean
:group 'cperl-speed)
@@ -535,8 +545,7 @@ One should tune up `cperl-close-paren-offset' as well."
:type 'boolean
:group 'cperl-indentation-details)
-(defcustom cperl-syntaxify-by-font-lock
- (boundp 'parse-sexp-lookup-properties)
+(defcustom cperl-syntaxify-by-font-lock t
"Non-nil means that CPerl uses the `font-lock' routines for syntaxification."
:type '(choice (const message) boolean)
:group 'cperl-speed)
@@ -665,10 +674,6 @@ micro-docs on what I know about CPerl problems.")
(defvar cperl-problems 'please-ignore-this-line
"Description of problems in CPerl mode.
-Some faces will not be shown on some versions of Emacs unless you
-install choose-color.el, available from
- http://ilyaz.org/software/emacs
-
`fill-paragraph' on a comment may leave the point behind the
paragraph. It also triggers a bug in some versions of Emacs (CPerl tries
to detect it and bulk out).
@@ -816,7 +821,7 @@ capable syntax engines).
(defvar cperl-speed 'please-ignore-this-line
"This is an incomplete compendium of what is available in other parts
-of CPerl documentation. (Please inform me if I skept anything.)
+of CPerl documentation. (Please inform me if I skipped anything.)
There is a perception that CPerl is slower than alternatives. This part
of documentation is designed to overcome this misconception.
@@ -1081,10 +1086,6 @@ versions of Emacs."
(define-key map [(control ?c) (control ?h) ?v]
;;(concat (char-to-string help-char) "v") ; does not work
'cperl-get-help))
- (or (boundp 'fill-paragraph-function)
- (substitute-key-definition
- 'fill-paragraph 'cperl-fill-paragraph
- map global-map))
(substitute-key-definition
'indent-sexp 'cperl-indent-exp
map global-map)
@@ -1240,6 +1241,7 @@ versions of Emacs."
["Auto fill" auto-fill-mode t])
("Indent styles..."
["CPerl" (cperl-set-style "CPerl") t]
+ ["PBP" (cperl-set-style "PBP") t]
["PerlStyle" (cperl-set-style "PerlStyle") t]
["GNU" (cperl-set-style "GNU") t]
["C++" (cperl-set-style "C++") t]
@@ -1306,7 +1308,7 @@ the last)."
cperl-maybe-white-and-comment-rex ; whitespace-comments
"\\(\\sw\\|_\\)+" ; attr-name
;; attr-arg (1 level of internal parens allowed!)
- "\\((\\(\\\\.\\|[^\\\\()]\\|([^\\\\()]*)\\)*)\\)?"
+ "\\((\\(\\\\.\\|[^\\()]\\|([^\\()]*)\\)*)\\)?"
"\\(" ; optional : (XXX allows trailing???)
cperl-maybe-white-and-comment-rex ; whitespace-comments
":\\)?"
@@ -1406,7 +1408,7 @@ the last)."
(defvar cperl-font-locking nil)
;; NB as it stands the code in cperl-mode assumes this only has one
-;; element. If XEmacs 19 support were dropped, this could all be simplified.
+;; element. Since XEmacs 19 support has been dropped, this could all be simplified.
(defvar cperl-compilation-error-regexp-alist
;; This look like a paranoiac regexp: could anybody find a better one? (which WORKS).
'(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
@@ -1559,12 +1561,12 @@ Variables controlling indentation style:
`cperl-min-label-indent'
Minimal indentation for line that is a label.
-Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith
- `cperl-indent-level' 5 4 2 4
- `cperl-brace-offset' 0 0 0 0
- `cperl-continued-brace-offset' -5 -4 0 0
- `cperl-label-offset' -5 -4 -2 -4
- `cperl-continued-statement-offset' 5 4 2 4
+Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith
+ `cperl-indent-level' 5 4 2 4 4
+ `cperl-brace-offset' 0 0 0 0 0
+ `cperl-continued-brace-offset' -5 -4 0 0 0
+ `cperl-label-offset' -5 -4 -2 -2 -4
+ `cperl-continued-statement-offset' 5 4 2 4 4
CPerl knows several indentation styles, and may bulk set the
corresponding variables. Use \\[cperl-set-style] to do this. Use
@@ -1604,6 +1606,9 @@ or as help on variables `cperl-tips', `cperl-problems',
(if (cperl-val 'cperl-electric-keywords)
(abbrev-mode 1))
(set-syntax-table cperl-mode-syntax-table)
+ ;; Workaround for Bug#30393, needed for Emacs 26.
+ (when (< emacs-major-version 27)
+ (setq-local open-paren-in-column-0-is-defun-start nil))
;; Until Emacs is multi-threaded, we do not actually need it local:
(make-local-variable 'cperl-font-lock-multiline-start)
(make-local-variable 'cperl-font-locking)
@@ -1637,9 +1642,8 @@ or as help on variables `cperl-tips', `cperl-problems',
"\\)"
cperl-maybe-white-and-comment-rex))
(set (make-local-variable 'comment-indent-function) #'cperl-comment-indent)
- (and (boundp 'fill-paragraph-function)
- (set (make-local-variable 'fill-paragraph-function)
- #'cperl-fill-paragraph))
+ (set (make-local-variable 'fill-paragraph-function)
+ #'cperl-fill-paragraph)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'indent-region-function) #'cperl-indent-region)
;;(setq auto-fill-function #'cperl-do-auto-fill) ; Need to switch on and off!
@@ -1701,13 +1705,8 @@ or as help on variables `cperl-tips', `cperl-problems',
;; to make font-lock think that font-lock-syntactic-keywords
;; are defined.
'(t)))))
- (if (boundp 'font-lock-multiline) ; Newer font-lock; use its facilities
- (progn
- (setq cperl-font-lock-multiline t) ; Not localized...
- (set (make-local-variable 'font-lock-multiline) t))
- (set (make-local-variable 'font-lock-fontify-region-function)
- ;; not present with old Emacs
- #'cperl-font-lock-fontify-region-function))
+ (setq cperl-font-lock-multiline t) ; Not localized...
+ (set (make-local-variable 'font-lock-multiline) t)
(set (make-local-variable 'font-lock-fontify-region-function)
#'cperl-font-lock-fontify-region-function)
(make-local-variable 'cperl-old-style)
@@ -1726,10 +1725,9 @@ or as help on variables `cperl-tips', `cperl-problems',
(if cperl-hook-after-change
(add-hook 'after-change-functions #'cperl-after-change-function nil t))
;; After hooks since fontification will break this
- (if cperl-pod-here-scan
- (or cperl-syntaxify-by-font-lock
- (progn (or cperl-faces-init (cperl-init-faces-weak))
- (cperl-find-pods-heres))))
+ (when (and cperl-pod-here-scan
+ (not cperl-syntaxify-by-font-lock))
+ (cperl-find-pods-heres))
;; Setup Flymake
(add-hook 'flymake-diagnostic-functions #'perl-flymake nil t))
@@ -3253,8 +3251,8 @@ Return the error message (if any). Does not work if delimiter is `)'.
Works before syntax recognition is done."
;; Works *before* syntax recognition is done
(or st-l (setq st-l (list nil))) ; Avoid overwriting '()
- (let (st b reset-st)
- (condition-case b
+ (let (st result reset-st)
+ (condition-case err
(progn
(setq st (cperl-cached-syntax-table st-l))
(modify-syntax-entry ?\( "()" st)
@@ -3262,8 +3260,7 @@ Works before syntax recognition is done."
(setq reset-st (syntax-table))
(set-syntax-table st)
(forward-sexp 1))
- (error (message
- "cperl-forward-group-in-re: error %s" b)))
+ (error (setq result err)))
;; now restore the initial state
(if st
(progn
@@ -3271,12 +3268,9 @@ Works before syntax recognition is done."
(modify-syntax-entry ?\) "." st)))
(if reset-st
(set-syntax-table reset-st))
- b))
+ result))
-(defvar font-lock-string-face)
-;;(defvar font-lock-reference-face)
-(defvar font-lock-constant-face)
(defsubst cperl-postpone-fontification (b e type val &optional now)
;; Do after syntactic fontification?
(if cperl-syntaxify-by-font-lock
@@ -3342,16 +3336,6 @@ Works before syntax recognition is done."
(setq end (point)))))
(or end pos)))))
-;; These are needed for byte-compile (at least with v19)
-(defvar cperl-nonoverridable-face)
-(defvar font-lock-variable-name-face)
-(defvar font-lock-function-name-face)
-(defvar font-lock-keyword-face)
-(defvar font-lock-builtin-face)
-(defvar font-lock-type-face)
-(defvar font-lock-comment-face)
-(defvar font-lock-warning-face)
-
(defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos)
"Syntactically mark (and fontify) attributes of a subroutine.
Should be called with the point before leading colon of an attribute."
@@ -3457,8 +3441,8 @@ Should be called with the point before leading colon of an attribute."
(match-beginning 4) (match-end 4)
'face dashface))
;; save match data (for looking-at)
- (setq lll (mapcar (function (lambda (elt) (cons (match-beginning elt)
- (match-end elt))))
+ (setq lll (mapcar (lambda (elt) (cons (match-beginning elt)
+ (match-end elt)))
l))
(while lll
(setq ll (car lll))
@@ -3560,19 +3544,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
"\\(\\`\n?\\|^\n\\)=" ; POD
"\\|"
;; One extra () before this:
- "<<~?" ; HERE-DOC
- "\\(" ; 1 + 1
+ "<<\\(~?\\)" ; HERE-DOC, indented-p = capture 2
+ "\\(" ; 2 + 1
;; First variant "BLAH" or just ``.
"[ \t]*" ; Yes, whitespace is allowed!
- "\\([\"'`]\\)" ; 2 + 1 = 3
- "\\([^\"'`\n]*\\)" ; 3 + 1
- "\\3"
+ "\\([\"'`]\\)" ; 3 + 1 = 4
+ "\\([^\"'`\n]*\\)" ; 4 + 1
+ "\\4"
"\\|"
;; Second variant: Identifier or \ID (same as 'ID') or empty
- "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
+ "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 5 + 1, 6 + 1
;; Do not have <<= or << 30 or <<30 or << $blah.
;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
- "\\(\\)" ; To preserve count of pars :-( 6 + 1
"\\)"
"\\|"
;; 1+6 extra () before this:
@@ -3762,11 +3745,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
;; "\\(\\)" ; To preserve count of pars :-( 6 + 1
;; "\\)"
- ((match-beginning 2) ; 1 + 1
+ ((match-beginning 3) ; 2 + 1
(setq b (point)
tb (match-beginning 0)
c (and ; not HERE-DOC
- (match-beginning 5)
+ (match-beginning 6)
(save-match-data
(or (looking-at "[ \t]*(") ; << function_call()
(save-excursion ; 1 << func_name, or $foo << 10
@@ -3793,17 +3776,17 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(looking-at "\\(printf?\\|say\\|system\\|exec\\|sort\\)\\>")))
(error t)))))))
(error nil))) ; func(<<EOF)
- (and (not (match-beginning 6)) ; Empty
+ (and (not (match-beginning 7)) ; Empty
(looking-at
"[ \t]*[=0-9$@%&(]"))))))
(if c ; Not here-doc
nil ; Skip it.
- (setq c (match-end 2)) ; 1 + 1
- (if (match-beginning 5) ;4 + 1
- (setq b1 (match-beginning 5) ; 4 + 1
- e1 (match-end 5)) ; 4 + 1
- (setq b1 (match-beginning 4) ; 3 + 1
- e1 (match-end 4))) ; 3 + 1
+ (setq c (match-end 3)) ; 2 + 1
+ (if (match-beginning 6) ;6 + 1
+ (setq b1 (match-beginning 6) ; 5 + 1
+ e1 (match-end 6)) ; 5 + 1
+ (setq b1 (match-beginning 5) ; 4 + 1
+ e1 (match-end 5))) ; 4 + 1
(setq tag (buffer-substring b1 e1)
qtag (regexp-quote tag))
(cond (cperl-pod-here-fontify
@@ -3818,8 +3801,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(setq b (point))
;; We do not search to max, since we may be called from
;; some hook of fontification, and max is random
- (or (and (re-search-forward (concat "^[ \t]*" qtag "$")
- stop-point 'toend)
+ (or (and (re-search-forward
+ (concat "^" (when (equal (match-string 2) "~") "[ \t]*")
+ qtag "$")
+ stop-point 'toend)
;;;(eq (following-char) ?\n) ; XXXX WHY???
)
(progn ; Pretend we matched at the end
@@ -3978,6 +3963,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(and (eq (preceding-char) ?.)
(eq (char-after (- (point) 2)) ?.))
(bobp))
+ ;; { $a++ / $b } doesn't start a regex, nor does $a--
+ (not (and (memq (preceding-char) '(?+ ?-))
+ (eq (preceding-char) (char-before (1- (point))))))
;; m|blah| ? foo : bar;
(not
(and (eq c ?\?)
@@ -4494,7 +4482,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
'syntax-table cperl-st-cfence))))
(setq was-subgr nil))
(t ; (?#)-comment
- ;; Inside "(" and "\" arn't special in any way
+ ;; Inside "(" and "\" aren't special in any way
;; Works also if the outside delimiters are ().
(or;;(if (eq (char-after b) ?\) )
;;(re-search-forward
@@ -4828,9 +4816,10 @@ conditional/loop constructs."
(while (< (point) tmp-end)
(parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
(or (eolp) (forward-sexp 1)))
- (if (> (point) tmp-end) ; Yes, there an unfinished block
+ (if (> (point) tmp-end) ; Check for an unfinished block
nil
(if (eq ?\) (preceding-char))
+ ;; closing parens can be preceded by up to three sexps
(progn ;; Plan B: find by REGEXP block followup this line
(setq top (point))
(condition-case nil
@@ -4851,7 +4840,9 @@ conditional/loop constructs."
(progn
(goto-char top)
(forward-sexp 1)
- (setq top (point)))))
+ (setq top (point)))
+ ;; no block to be processed: expression ends here
+ (setq done t)))
(error (setq done t)))
(goto-char top))
(if (looking-at ; Try Plan C: continuation block
@@ -4884,7 +4875,7 @@ Returns some position at the last line."
;; }? continue
;; blah; }
(if (not
- (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)")
+ (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|unless\\|until\\)\\_>")
(setq have-brace (save-excursion (search-forward "}" ee t)))))
nil ; Do not need to do anything
;; Looking at:
@@ -4892,7 +4883,7 @@ Returns some position at the last line."
;; else
(if cperl-merge-trailing-else
(if (looking-at
- "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>")
+ "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\_>")
(progn
(search-forward "}")
(setq p (point))
@@ -4900,7 +4891,7 @@ Returns some position at the last line."
(delete-region p (point))
(insert (make-string cperl-indent-region-fix-constructs ?\s))
(beginning-of-line)))
- (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\>")
+ (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\_>")
(save-excursion
(search-forward "}")
(delete-horizontal-space)
@@ -4912,7 +4903,7 @@ Returns some position at the last line."
(setq ret (point)))))))
;; Looking at:
;; } else
- (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>")
+ (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\_>")
(progn
(search-forward "}")
(delete-horizontal-space)
@@ -5447,8 +5438,7 @@ indentation and initial hashes. Behaves usually outside of comment."
(cond ((featurep 'ps-print)
(or cperl-faces-init
(progn
- (and (boundp 'font-lock-multiline)
- (setq cperl-font-lock-multiline t))
+ (setq cperl-font-lock-multiline t)
(cperl-init-faces))))
((not cperl-faces-init)
(add-hook 'font-lock-mode-hook
@@ -5480,27 +5470,12 @@ indentation and initial hashes. Behaves usually outside of comment."
(or cperl-faces-init (cperl-init-faces))
cperl-font-lock-keywords-2)
-(defun cperl-init-faces-weak ()
- ;; Allow `cperl-find-pods-heres' to run.
- (or (boundp 'font-lock-constant-face)
- (cperl-force-face font-lock-constant-face
- "Face for constant and label names"))
- (or (boundp 'font-lock-warning-face)
- (cperl-force-face font-lock-warning-face
- "Face for things which should stand out"))
- ;;(setq font-lock-constant-face 'font-lock-constant-face)
- )
-
(defun cperl-init-faces ()
(condition-case errs
(progn
(require 'font-lock)
- (and (fboundp 'font-lock-fontify-anchored-keywords)
- (featurep 'font-lock-extra)
- (message "You have an obsolete package `font-lock-extra'. Install `choose-color'."))
(let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored)
- (if (fboundp 'font-lock-fontify-anchored-keywords)
- (setq font-lock-anchored t))
+ (setq font-lock-anchored t)
(setq
t-font-lock-keywords
(list
@@ -5622,7 +5597,7 @@ indentation and initial hashes. Behaves usually outside of comment."
"wh\\(en\\|ile\\)\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
"\\|[sm]" ; Added manually
"\\)\\>")
- 2 'cperl-nonoverridable-face)
+ 2 ''cperl-nonoverridable-face) ; unbound as var, so: doubly quoted
;; (mapconcat #'identity
;; '("#endif" "#else" "#ifdef" "#ifndef" "#if"
;; "#include" "#define" "#undef")
@@ -5658,17 +5633,13 @@ indentation and initial hashes. Behaves usually outside of comment."
2 font-lock-function-name-face)
'("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$"
1 font-lock-function-name-face)
- (cond ((featurep 'font-lock-extra)
- '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
- (2 font-lock-string-face t)
- (0 '(restart 2 t)))) ; To highlight $a{bc}{ef}
- (font-lock-anchored
- '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
+ (cond (font-lock-anchored
+ '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
(2 font-lock-string-face t)
("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
nil nil
(1 font-lock-string-face t))))
- (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
+ (t '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
2 font-lock-string-face t)))
'("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
font-lock-string-face t)
@@ -5680,15 +5651,7 @@ indentation and initial hashes. Behaves usually outside of comment."
;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face)
;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)"
;;; (2 (cons font-lock-variable-name-face '(underline))))
- (cond ((featurep 'font-lock-extra)
- '("^[ \t]*\\(state\\|my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
- (3 font-lock-variable-name-face)
- (4 '(another 4 nil
- ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
- (1 font-lock-variable-name-face)
- (2 '(restart 2 nil) nil t)))
- nil t))) ; local variables, multiple
- (font-lock-anchored
+ (cond (font-lock-anchored
;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var
`(,(concat "\\<\\(state\\|my\\|local\\|our\\)"
cperl-maybe-white-and-comment-rex
@@ -5752,7 +5715,7 @@ indentation and initial hashes. Behaves usually outside of comment."
(if (eq (char-after (match-beginning 2)) ?%)
'cperl-hash-face
'cperl-array-face)
- t) ; arrays and hashes
+ nil) ; arrays and hashes
("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
1
(if (= (- (match-end 2) (match-beginning 2)) 1)
@@ -5787,167 +5750,9 @@ indentation and initial hashes. Behaves usually outside of comment."
t-font-lock-keywords)
cperl-font-lock-keywords cperl-font-lock-keywords-1
cperl-font-lock-keywords-2 (append
- cperl-font-lock-keywords-1
- t-font-lock-keywords-1)))
+ t-font-lock-keywords-1
+ cperl-font-lock-keywords-1)))
(if (fboundp 'ps-print-buffer) (cperl-ps-print-init))
- (if (or (featurep 'choose-color) (featurep 'font-lock-extra))
- (eval ; Avoid a warning
- '(font-lock-require-faces
- (list
- ;; Color-light Color-dark Gray-light Gray-dark Mono
- (list 'font-lock-comment-face
- ["Firebrick" "OrangeRed" "DimGray" "Gray80"]
- nil
- [nil nil t t t]
- [nil nil t t t]
- nil)
- (list 'font-lock-string-face
- ["RosyBrown" "LightSalmon" "Gray50" "LightGray"]
- nil
- nil
- [nil nil t t t]
- nil)
- (list 'font-lock-function-name-face
- (vector
- "Blue" "LightSkyBlue" "Gray50" "LightGray"
- (cdr (assq 'background-color ; if mono
- (frame-parameters))))
- (vector
- nil nil nil nil
- (cdr (assq 'foreground-color ; if mono
- (frame-parameters))))
- [nil nil t t t]
- nil
- nil)
- (list 'font-lock-variable-name-face
- ["DarkGoldenrod" "LightGoldenrod" "DimGray" "Gray90"]
- nil
- [nil nil t t t]
- [nil nil t t t]
- nil)
- (list 'font-lock-type-face
- ["DarkOliveGreen" "PaleGreen" "DimGray" "Gray80"]
- nil
- [nil nil t t t]
- nil
- [nil nil t t t])
- (list 'font-lock-warning-face
- ["Pink" "Red" "Gray50" "LightGray"]
- ["gray20" "gray90"
- "gray80" "gray20"]
- [nil nil t t t]
- nil
- [nil nil t t t]
- )
- (list 'font-lock-constant-face
- ["CadetBlue" "Aquamarine" "Gray50" "LightGray"]
- nil
- [nil nil t t t]
- nil
- [nil nil t t t])
- (list 'cperl-nonoverridable-face
- ["chartreuse3" ("orchid1" "orange")
- nil "Gray80"]
- [nil nil "gray90"]
- [nil nil nil t t]
- [nil nil t t]
- [nil nil t t t])
- (list 'cperl-array-face
- ["blue" "yellow" nil "Gray80"]
- ["lightyellow2" ("navy" "os2blue" "darkgreen")
- "gray90"]
- t
- nil
- nil)
- (list 'cperl-hash-face
- ["red" "red" nil "Gray80"]
- ["lightyellow2" ("navy" "os2blue" "darkgreen")
- "gray90"]
- t
- t
- nil))))
- ;; Do it the dull way, without choose-color
- (cperl-force-face font-lock-constant-face
- "Face for constant and label names")
- (cperl-force-face font-lock-variable-name-face
- "Face for variable names")
- (cperl-force-face font-lock-type-face
- "Face for data types")
- (cperl-force-face cperl-nonoverridable-face
- "Face for data types from another group")
- (cperl-force-face font-lock-warning-face
- "Face for things which should stand out")
- (cperl-force-face font-lock-comment-face
- "Face for comments")
- (cperl-force-face font-lock-function-name-face
- "Face for function names")
- ;;(defvar font-lock-constant-face 'font-lock-constant-face)
- ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face)
- ;;(or (boundp 'font-lock-type-face)
- ;; (defconst font-lock-type-face
- ;; 'font-lock-type-face
- ;; "Face to use for data types."))
- ;;(or (boundp 'cperl-nonoverridable-face)
- ;; (defconst cperl-nonoverridable-face
- ;; 'cperl-nonoverridable-face
- ;; "Face to use for data types from another group."))
- (if (and
- (not (facep 'cperl-array-face))
- (facep 'font-lock-emphasized-face))
- (copy-face 'font-lock-emphasized-face 'cperl-array-face))
- (if (and
- (not (facep 'cperl-hash-face))
- (facep 'font-lock-other-emphasized-face))
- (copy-face 'font-lock-other-emphasized-face 'cperl-hash-face))
- (if (and
- (not (facep 'cperl-nonoverridable-face))
- (facep 'font-lock-other-type-face))
- (copy-face 'font-lock-other-type-face 'cperl-nonoverridable-face))
- ;;(or (boundp 'cperl-hash-face)
- ;; (defconst cperl-hash-face
- ;; 'cperl-hash-face
- ;; "Face to use for hashes."))
- ;;(or (boundp 'cperl-array-face)
- ;; (defconst cperl-array-face
- ;; 'cperl-array-face
- ;; "Face to use for arrays."))
- (let ((background 'light))
- (and (not (facep 'font-lock-constant-face))
- (facep 'font-lock-reference-face)
- (copy-face 'font-lock-reference-face 'font-lock-constant-face))
- (if (facep 'font-lock-type-face) nil
- (copy-face 'default 'font-lock-type-face)
- (cond
- ((eq background 'light)
- (set-face-foreground 'font-lock-type-face
- (if (x-color-defined-p "seagreen")
- "seagreen"
- "sea green")))
- ((eq background 'dark)
- (set-face-foreground 'font-lock-type-face
- (if (x-color-defined-p "os2pink")
- "os2pink"
- "pink")))
- (t
- (set-face-background 'font-lock-type-face "gray90"))))
- (if (facep 'cperl-nonoverridable-face)
- nil
- (copy-face 'font-lock-type-face 'cperl-nonoverridable-face)
- (cond
- ((eq background 'light)
- (set-face-foreground 'cperl-nonoverridable-face
- (if (x-color-defined-p "chartreuse3")
- "chartreuse3"
- "chartreuse")))
- ((eq background 'dark)
- (set-face-foreground 'cperl-nonoverridable-face
- (if (x-color-defined-p "orchid1")
- "orchid1"
- "orange")))))
- (if (facep 'font-lock-variable-name-face) nil
- (copy-face 'italic 'font-lock-variable-name-face))
- (if (facep 'font-lock-constant-face) nil
- (copy-face 'italic 'font-lock-constant-face))))
(setq cperl-faces-init t))
(error (message "cperl-init-faces (ignored): %s" errs))))
@@ -6057,7 +5862,19 @@ if (foo) {
stop;
}
-### PerlStyle (=CPerl with 4 as indent) 4/0/0/-4/4/t/nil
+### PBP (=Perl Best Practices) 4/0/0/-4/4/nil/nil
+if (foo) {
+ bar
+ baz;
+ label:
+ {
+ boon;
+ }
+}
+else {
+ stop;
+}
+### PerlStyle (=CPerl with 4 as indent) 4/0/0/-2/4/t/nil
if (foo) {
bar
baz;
@@ -6160,6 +5977,19 @@ else
(cperl-extra-newline-before-brace-multiline . nil)
(cperl-merge-trailing-else . t))
+ ("PBP" ;; Perl Best Practices by Damian Conway
+ (cperl-indent-level . 4)
+ (cperl-brace-offset . 0)
+ (cperl-continued-brace-offset . 0)
+ (cperl-label-offset . -2)
+ (cperl-continued-statement-offset . 4)
+ (cperl-close-paren-offset . -4)
+ (cperl-extra-newline-before-brace . nil)
+ (cperl-extra-newline-before-brace-multiline . nil)
+ (cperl-merge-trailing-else . nil)
+ (cperl-indent-parens-as-block . t)
+ (cperl-tab-always-indent . t))
+
("PerlStyle" ; CPerl with 4 as indent
(cperl-indent-level . 4)
(cperl-brace-offset . 0)
@@ -6231,7 +6061,8 @@ See examples in `cperl-style-examples'.")
"Set CPerl mode variables to use one of several different indentation styles.
The arguments are a string representing the desired style.
The list of styles is in `cperl-style-alist', available styles
-are CPerl, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith.
+are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\"
+and \"Whitesmith\".
The current value of style is memorized (unless there is a memorized
data already), may be restored by `cperl-set-style-back'.
@@ -6317,8 +6148,7 @@ Customized by setting variables `cperl-shrink-wrap-info-frame',
(interactive
(let* ((default (cperl-word-at-point))
(read (read-string
- (format "Find doc for Perl function (default %s): "
- default))))
+ (cperl--format-prompt "Find doc for Perl function" default))))
(list (if (equal read "")
default
read))))
@@ -6499,9 +6329,10 @@ If optional argument ALL is `recursive', will process Perl files
in subdirectories too."
(interactive)
(let ((cmd "etags")
- (args '("-l" "none" "-r"
+ (args `("-l" "none" "-r"
;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!)
- "/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/"
+ ,(concat
+ "/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/")
"-r"
"/\\<package[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\([#;]\\|$\\)/\\1/"
"-r"
@@ -6786,6 +6617,7 @@ Use as
(or topdir
(setq topdir default-directory))
(let ((tags-file-name "TAGS")
+ (inhibit-read-only t)
(case-fold-search nil)
xs rel)
(save-excursion
@@ -6851,7 +6683,7 @@ Use as
(insert (cperl-find-tags file xs topdir))))))
(if inbuffer nil ; Delegate to the caller
(save-buffer 0) ; No backup
- (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs?
+ (if (fboundp 'initialize-new-tags-table)
(initialize-new-tags-table))))))
(defvar cperl-tags-hier-regexp-list
@@ -6926,10 +6758,10 @@ One may build such TAGS files from CPerl mode menu."
(require 'etags)
(require 'imenu)
(if (or update (null (nth 2 cperl-hierarchy)))
- (let ((remover (function (lambda (elt) ; (name (file1...) (file2..))
- (or (nthcdr 2 elt)
- ;; Only in one file
- (setcdr elt (cdr (nth 1 elt)))))))
+ (let ((remover (lambda (elt) ; (name (file1...) (file2..))
+ (or (nthcdr 2 elt)
+ ;; Only in one file
+ (setcdr elt (cdr (nth 1 elt))))))
to l1 l2 l3)
;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
(setq cperl-hierarchy (list l1 l2 l3))
@@ -7009,33 +6841,33 @@ One may build such TAGS files from CPerl mode menu."
(setq ord 2)
(mapc move-deeper methods)
(if recurse
- (mapc (function (lambda (elt)
- (cperl-tags-treeify elt (1+ level))))
+ (mapc (lambda (elt)
+ (cperl-tags-treeify elt (1+ level)))
(cdr to)))
;;Now clean up leaders with one child only
- (mapc (function (lambda (elt)
- (if (not (and (listp (cdr elt))
- (eq (length elt) 2)))
- nil
- (setcar elt (car (nth 1 elt)))
- (setcdr elt (cdr (nth 1 elt))))))
+ (mapc (lambda (elt)
+ (if (not (and (listp (cdr elt))
+ (eq (length elt) 2)))
+ nil
+ (setcar elt (car (nth 1 elt)))
+ (setcdr elt (cdr (nth 1 elt)))))
(cdr to))
;; Sort the roots of subtrees
(if (default-value 'imenu-sort-function)
(setcdr to
(sort (cdr to) (default-value 'imenu-sort-function))))
;; Now add back functions removed from display
- (mapc (function (lambda (elt)
- (setcdr to (cons elt (cdr to)))))
+ (mapc (lambda (elt)
+ (setcdr to (cons elt (cdr to))))
(if (default-value 'imenu-sort-function)
(nreverse
(sort root-functions (default-value 'imenu-sort-function)))
root-functions))
;; Now add back packages removed from display
- (mapc (function (lambda (elt)
- (setcdr to (cons (cons (concat "package " (car elt))
- (cdr elt))
- (cdr to)))))
+ (mapc (lambda (elt)
+ (setcdr to (cons (cons (concat "package " (car elt))
+ (cdr elt))
+ (cdr to))))
(if (default-value 'imenu-sort-function)
(nreverse
(sort root-packages (default-value 'imenu-sort-function)))
@@ -8275,10 +8107,7 @@ the appropriate statement modifier."
(interactive
(list (let* ((default-entry (cperl-word-at-point))
(input (read-string
- (format "perldoc entry%s: "
- (if (string= default-entry "")
- ""
- (format " (default %s)" default-entry))))))
+ (cperl--format-prompt "perldoc entry" default-entry))))
(if (string= input "")
(if (string= default-entry "")
(error "No perldoc args given")
@@ -8382,11 +8211,11 @@ a result of qr//, this is not a performance hit), t for the rest."
(and (eq (get-text-property beg 'syntax-type) 'string)
(setq beg (next-single-property-change beg 'syntax-type nil limit)))
(cperl-map-pods-heres
- (function (lambda (s _e _p)
- (if (memq (get-text-property s 'REx-interpolated) skip)
- t
- (setq pp s)
- nil))) ; nil stops
+ (lambda (s _e _p)
+ (if (memq (get-text-property s 'REx-interpolated) skip)
+ t
+ (setq pp s)
+ nil)) ; nil stops
'REx-interpolated beg limit)
(if pp (goto-char pp)
(message "No more interpolated REx"))))
@@ -8505,7 +8334,7 @@ start with default arguments, then refine the slowdown regions."
(or l (setq l 1))
(or step (setq step 500))
(or lim (setq lim 40))
- (let* ((timems (function (lambda () (car (time-convert nil 1000)))))
+ (let* ((timems (lambda () (car (cperl--time-convert nil 1000))))
(tt (funcall timems)) (c 0) delta tot)
(goto-char (point-min))
(forward-line (1- l))
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index bcbe669c16e..65ef83f7698 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -1,4 +1,4 @@
-;;; cpp.el --- highlight or hide text according to cpp conditionals
+;;; cpp.el --- highlight or hide text according to cpp conditionals -*- lexical-binding: t -*-
;; Copyright (C) 1994-1995, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index dfb987bf99a..6e84f4f1bcc 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -4,7 +4,7 @@
;; Author: Anders Lindgren
;; Keywords: c, languages, faces
-;; Version: 1.3.1
+;; Old-Version: 1.3.1
;; This file is part of GNU Emacs.
@@ -168,6 +168,8 @@ deactivated."
:tag "Load Hook"
:group 'cwarn
:type 'hook)
+(make-obsolete-variable 'cwarn-load-hook
+ "use `with-eval-after-load' instead." "28.1")
;;}}}
;;{{{ The modes
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index ab3321f6868..ca45795adc0 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -557,8 +557,7 @@ Variables controlling indentation style and extra features:
dcl-imenu-label-call
Change the text that is used as sub-listing labels in imenu.
-Loading this package calls the value of the variable
-`dcl-mode-load-hook' with no args, if that value is non-nil.
+To run code after DCL mode has loaded, use `with-eval-after-load'.
Turning on DCL mode calls the value of the variable `dcl-mode-hook'
with no args, if that value is non-nil.
@@ -2192,6 +2191,8 @@ otherwise return nil."
(provide 'dcl-mode)
+(make-obsolete-variable 'dcl-mode-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'dcl-mode-load-hook) ; for your customizations
;;; dcl-mode.el ends here
diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el
index dc6bd44e482..be82c72910b 100644
--- a/lisp/progmodes/ebnf-abn.el
+++ b/lisp/progmodes/ebnf-abn.el
@@ -38,7 +38,7 @@
;; -----------
;;
;; See the URL:
-;; `http://www.ietf.org/rfc/rfc2234.txt'
+;; `https://www.ietf.org/rfc/rfc2234.txt'
;; or
;; `http://www.faqs.org/rfcs/rfc2234.html'
;; or
@@ -474,11 +474,10 @@
(aset ebnf-abn-token-table ?\; 'comment)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-abn-non-terminal-chars
- (ebnf-range-regexp "-_0-9A-Za-z" ?\240 ?\377))
+ "-_0-9A-Za-z\u00a0-\u00ff")
(defconst ebnf-abn-non-terminal-letter-chars
- (ebnf-range-regexp "A-Za-z" ?\240 ?\377))
+ "A-Za-z\u00a0-\u00ff")
(defun ebnf-abn-lex ()
@@ -572,9 +571,8 @@ See documentation for variable `ebnf-abn-lex'."
(not eor-p)))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-abn-comment-chars
- (ebnf-range-regexp "^\n\000-\010\016-\037" ?\177 ?\237))
+ "^\n\000-\010\016-\037\177\u0080-\u009f")
(defun ebnf-abn-skip-comment ()
@@ -612,9 +610,8 @@ See documentation for variable `ebnf-abn-lex'."
(ebnf-buffer-substring ebnf-abn-comment-chars))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-abn-string-chars
- (ebnf-range-regexp " -!#-~" ?\240 ?\377))
+ " !#-~\u00a0-\u00ff")
(defun ebnf-abn-string ()
diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el
index 583740d3617..4e11862c1dc 100644
--- a/lisp/progmodes/ebnf-bnf.el
+++ b/lisp/progmodes/ebnf-bnf.el
@@ -419,9 +419,8 @@
(aset ebnf-bnf-token-table ebnf-lex-eop-char 'period)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-bnf-non-terminal-chars
- (ebnf-range-regexp "!#%&'*-,0-:<>@-Z\\\\^-z~" ?\240 ?\377))
+ "!#%&'*-,0-:<>@-Z\\\\^-z~\u00a0-\u00ff")
(defun ebnf-bnf-lex ()
@@ -520,9 +519,8 @@ See documentation for variable `ebnf-bnf-lex'."
))))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-bnf-comment-chars
- (ebnf-range-regexp "^\n\000-\010\016-\037" ?\177 ?\237))
+ "^\n\000-\010\016-\037\177\u0080-\u009f")
(defun ebnf-bnf-skip-comment ()
diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el
index 7e824e487aa..ddddb27a11c 100644
--- a/lisp/progmodes/ebnf-dtd.el
+++ b/lisp/progmodes/ebnf-dtd.el
@@ -38,11 +38,11 @@
;; ----------
;;
;; See the URLs:
-;; `http://www.w3.org/TR/2004/REC-xml-20040204/'
+;; `https://www.w3.org/TR/2004/REC-xml-20040204/'
;; (Extensible Markup Language (XML) 1.0 (Third Edition))
-;; `http://www.w3.org/TR/html40/'
+;; `https://www.w3.org/TR/html40/'
;; (HTML 4.01 Specification)
-;; `http://www.w3.org/TR/NOTE-html-970421'
+;; `https://www.w3.org/TR/NOTE-html-970421'
;; (HTML DTD with support for Style Sheets)
;;
;;
@@ -1108,9 +1108,8 @@
(aset ebnf-dtd-token-table ?\] 'end-subset)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-dtd-name-chars
- (ebnf-range-regexp "-._:0-9A-Za-z" ?\240 ?\377))
+ "-._:0-9A-Za-z\u00a0-\u00ff")
(defconst ebnf-dtd-decl-alist
@@ -1263,11 +1262,10 @@ See documentation for variable `ebnf-dtd-lex'."
(format "%s%s;" start char)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-dtd-double-string-chars
- (ebnf-range-regexp "\t -!#-~" ?\240 ?\377))
+ "\t -!#-~\u00a0-\u00ff")
(defconst ebnf-dtd-single-string-chars
- (ebnf-range-regexp "\t -&(-~" ?\240 ?\377))
+ "\t -&(-~\u00a0-\u00ff")
(defun ebnf-dtd-string (delim)
@@ -1287,11 +1285,10 @@ See documentation for variable `ebnf-dtd-lex'."
(forward-char)))))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-dtd-comment-chars
- (ebnf-range-regexp "^-\000-\010\013\014\016-\037" ?\177 ?\237))
+ "^-\000-\010\013\014\016-\037\177\u0080-\u009f")
(defconst ebnf-dtd-filename-chars
- (ebnf-range-regexp "^-\000-\037" ?\177 ?\237))
+ "^-\000-\037\177\u0080-\u009f")
(defun ebnf-dtd-skip-comment ()
diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el
index 2ae6fb67569..546f1f8a87f 100644
--- a/lisp/progmodes/ebnf-ebx.el
+++ b/lisp/progmodes/ebnf-ebx.el
@@ -38,7 +38,7 @@
;; ------------
;;
;; See the URL:
-;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
+;; `https://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
;; (Extensible Markup Language (XML) 1.0 (Third Edition))
;;
;;
@@ -405,11 +405,10 @@
(aset ebnf-ebx-token-table ?/ 'comment)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-ebx-non-terminal-chars
- (ebnf-range-regexp "-_A-Za-z" ?\240 ?\377))
+ "-_A-Za-z\u00a0-\u00ff")
(defconst ebnf-ebx-non-terminal-letter-chars
- (ebnf-range-regexp "A-Za-z" ?\240 ?\377))
+ "A-Za-z\u00a0-\u00ff")
(defun ebnf-ebx-lex ()
@@ -488,9 +487,8 @@ See documentation for variable `ebnf-ebx-lex'."
))))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-ebx-constraint-chars
- (ebnf-range-regexp "^\000-\010\016-\037]" ?\177 ?\237))
+ "^\000-\010\016-\037]\177\u0080-\u009f")
(defun ebnf-ebx-skip-constraint ()
@@ -517,11 +515,10 @@ See documentation for variable `ebnf-ebx-lex'."
(not eor-p)))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-ebx-comment-chars
- (ebnf-range-regexp "^\000-\010\016-\037\\*" ?\177 ?\237))
+ "^\000-\010\016-\037*\177\u0080-\u009f")
(defconst ebnf-ebx-filename-chars
- (ebnf-range-regexp "^\000-\037\\*" ?\177 ?\237))
+ "^\000-\037*\177\u0080-\u009f")
(defun ebnf-ebx-skip-comment ()
@@ -581,11 +578,10 @@ See documentation for variable `ebnf-ebx-lex'."
(concat fname (make-string nchar ?*)))))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-ebx-double-string-chars
- (ebnf-range-regexp "\t -!#-~" ?\240 ?\377))
+ "\t -!#-~\u00a0-\u00ff")
(defconst ebnf-ebx-single-string-chars
- (ebnf-range-regexp "\t -&(-~" ?\240 ?\377))
+ "\t -&(-~\u00a0-\u00ff")
(defun ebnf-ebx-string (delim)
diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el
index b52094a5912..466e7785053 100644
--- a/lisp/progmodes/ebnf-iso.el
+++ b/lisp/progmodes/ebnf-iso.el
@@ -379,9 +379,8 @@
(aset ebnf-iso-token-table ?. 'character)))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
(defconst ebnf-iso-non-terminal-chars
- (ebnf-range-regexp " 0-9A-Za-z_" ?\240 ?\377))
+ " 0-9A-Za-z_\u00a0-\u00ff")
(defun ebnf-iso-lex ()
@@ -487,9 +486,8 @@ See documentation for variable `ebnf-iso-lex'."
))))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-iso-comment-chars
- (ebnf-range-regexp "^*(\000-\010\016-\037" ?\177 ?\237))
+ "^*(\000-\010\016-\037\177\u0080-\u009f")
(defun ebnf-iso-skip-comment ()
diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el
index f5d633e8460..a657c637f82 100644
--- a/lisp/progmodes/ebnf-yac.el
+++ b/lisp/progmodes/ebnf-yac.el
@@ -397,9 +397,8 @@ See documentation for variable `ebnf-yac-lex'."
(< (point) ebnf-limit))
-;; replace the range "\177-\377" (see `ebnf-range-regexp').
(defconst ebnf-yac-skip-chars
- (ebnf-range-regexp "^{}/'\"\000-\010\013\016-\037" ?\177 ?\377))
+ "^{}/'\"\000-\010\013\016-\037\177\u0080-\u009f")
(defun ebnf-yac-skip-code ()
@@ -442,9 +441,8 @@ See documentation for variable `ebnf-yac-lex'."
))
-;; replace the range "\177-\237" (see `ebnf-range-regexp').
(defconst ebnf-yac-comment-chars
- (ebnf-range-regexp "^*\000-\010\013\016-\037" ?\177 ?\237))
+ "^*\000-\010\013\016-\037\177\u0080-\u009f")
(defun ebnf-yac-skip-comment ()
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 640cb576ef6..991cd6fc519 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -5,7 +5,7 @@
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
;; Version: 4.4
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; This file is part of GNU Emacs.
@@ -326,7 +326,7 @@ Please send all bug fixes and enhancements to
;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
;;
;; `abnf' ebnf2ps recognizes the syntax described in the URL:
-;; `http://www.ietf.org/rfc/rfc2234.txt'
+;; `https://www.ietf.org/rfc/rfc2234.txt'
;; ("Augmented BNF for Syntax Specifications: ABNF").
;;
;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
@@ -342,11 +342,11 @@ Please send all bug fixes and enhancements to
;; `ebnf-yac-ignore-error-recovery'.
;;
;; `ebnfx' ebnf2ps recognizes the syntax described in the URL:
-;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
+;; `https://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
;;
;; `dtd' ebnf2ps recognizes the syntax described in the URL:
-;; `http://www.w3.org/TR/2004/REC-xml-20040204/'
+;; `https://www.w3.org/TR/2004/REC-xml-20040204/'
;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
;;
;; Any other value is treated as `ebnf'.
@@ -1157,21 +1157,6 @@ Please send all bug fixes and enhancements to
(and (string< ps-print-version "5.2.3")
(error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
-
-;; to avoid gripes with Emacs 20
-(or (fboundp 'assq-delete-all)
- (defun assq-delete-all (key alist)
- "Delete from ALIST all elements whose car is KEY.
-Return the modified alist.
-Elements of ALIST that are not conses are ignored."
- (let ((tail alist))
- (while tail
- (if (and (consp (car tail))
- (eq (car (car tail)) key))
- (setq alist (delq (car tail) alist)))
- (setq tail (cdr tail)))
- alist)))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User Variables:
@@ -1794,7 +1779,7 @@ Valid values are:
`ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
`abnf' ebnf2ps recognizes the syntax described in the URL:
- `http://www.ietf.org/rfc/rfc2234.txt'
+ `https://www.ietf.org/rfc/rfc2234.txt'
(\"Augmented BNF for Syntax Specifications: ABNF\").
`iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
@@ -1810,11 +1795,11 @@ Valid values are:
`ebnf-yac-ignore-error-recovery'.
`ebnfx' ebnf2ps recognizes the syntax described in the URL:
- `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
+ `https://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
(\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
`dtd' ebnf2ps recognizes the syntax described in the URL:
- `http://www.w3.org/TR/2004/REC-xml-20040204/'
+ `https://www.w3.org/TR/2004/REC-xml-20040204/'
(\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
Any other value is treated as `ebnf'."
@@ -2053,8 +2038,7 @@ It must be a float between 0.0 (top) and 1.0 (bottom)."
;; Printing color requires x-color-values.
-(defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs
- (fboundp 'color-instance-rgb-components)) ; XEmacs
+(defcustom ebnf-color-p t
"Non-nil means use color."
:type 'boolean
:version "20"
@@ -2738,8 +2722,7 @@ Used in functions `ebnf-reset-style', `ebnf-push-style' and
(ebnf-eps-footer-font . '(7 Helvetica "Black" "White" bold))
(ebnf-eps-footer . nil)
(ebnf-entry-percentage . 0.5)
- (ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs
- (fboundp 'color-instance-rgb-components))) ; XEmacs
+ (ebnf-color-p . t)
(ebnf-line-width . 1.0)
(ebnf-line-color . "Black")
(ebnf-debug-ps . nil)
@@ -4544,7 +4527,7 @@ end
(let* ((ebnf-tree tree)
(ps-color-p (and ebnf-color-p (ps-color-device)))
(ps-print-color-scale (if ps-color-p
- (float (car (ps-color-values "white")))
+ (float (car (color-values "white")))
1.0))
(ebnf-total (length ebnf-tree))
(ebnf-nprod 0)
@@ -4646,7 +4629,7 @@ end
(let* ((ebnf-tree tree)
(ps-color-p (and ebnf-color-p (ps-color-device)))
(ps-print-color-scale (if ps-color-p
- (float (car (ps-color-values "white")))
+ (float (car (color-values "white")))
1.0))
ps-zebra-stripes ps-line-number ps-razzle-dazzle
ps-print-hook
@@ -4979,18 +4962,6 @@ killed after process termination."
(kill-buffer (current-buffer))))
-;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward'
-;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or
-;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or
-;; from \177 to \237). It seems that version 20.7 has the same problem.
-(defun ebnf-range-regexp (prefix from to)
- (let (str)
- (while (<= from to)
- (setq str (concat str (char-to-string from))
- from (1+ from)))
- (concat prefix str)))
-
-
(defvar ebnf-map-name
(let ((map (make-vector 256 ?\_)))
(mapc #'(lambda (char)
@@ -5004,8 +4975,6 @@ killed after process termination."
(defun ebnf-eps-filename (str)
(let* ((len (length str))
(stri 0)
- ;; to keep compatibility with Emacs 20 & 21:
- ;; DO NOT REPLACE `?\ ' BY `?\s'
(new (make-string len ?\ )))
(while (< stri len)
(aset new stri (aref ebnf-map-name (aref str stri)))
@@ -5987,8 +5956,7 @@ killed after process termination."
(point))))
-;; replace the range "\240-\377" (see `ebnf-range-regexp').
-(defconst ebnf-8-bit-chars (ebnf-range-regexp "" ?\240 ?\377))
+(defconst ebnf-8-bit-chars "\u00a0-\u00ff")
(defun ebnf-string (chars eos-char kind)
@@ -6023,8 +5991,6 @@ killed after process termination."
(defun ebnf-trim-right (str)
(let* ((len (1- (length str)))
(index len))
- ;; to keep compatibility with Emacs 20 & 21:
- ;; DO NOT REPLACE `?\ ' BY `?\s'
(while (and (> index 0) (= (aref str index) ?\ ))
(setq index (1- index)))
(if (= index len)
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index c84803a3fab..ffd7d03d7a9 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -34,6 +34,7 @@
;;; Code:
(require 'cl-lib)
+(require 'seq)
(require 'easymenu)
(require 'view)
(require 'ebuff-menu)
@@ -52,32 +53,27 @@
"List of directories to search for source files in a class tree.
Elements should be directory names; nil as an element means to try
to find source files relative to the location of the BROWSE file loaded."
- :group 'ebrowse
:type '(repeat (choice (const :tag "Default" nil)
(string :tag "Directory"))))
(defcustom ebrowse-view/find-hook nil
"Hooks run after finding or viewing a member or class."
- :group 'ebrowse
:type 'hook)
(defcustom ebrowse-not-found-hook nil
"Hooks run when finding or viewing a member or class was not successful."
- :group 'ebrowse
:type 'hook)
(defcustom ebrowse-electric-list-mode-hook nil
"Hook called by `ebrowse-electric-position-mode'."
- :group 'ebrowse
:type 'hook)
(defcustom ebrowse-max-positions 50
"Number of markers saved on electric position stack."
- :group 'ebrowse
:type 'integer)
@@ -89,32 +85,27 @@ to find source files relative to the location of the BROWSE file loaded."
(defcustom ebrowse-tree-mode-hook nil
"Hook run in each new tree buffer."
- :group 'ebrowse-tree
:type 'hook)
(defcustom ebrowse-tree-buffer-name "*Tree*"
"The default name of class tree buffers."
- :group 'ebrowse-tree
:type 'string)
(defcustom ebrowse--indentation 4
"The amount by which subclasses are indented in the tree."
- :group 'ebrowse-tree
:type 'integer)
(defcustom ebrowse-source-file-column 40
"The column in which source file names are displayed in the tree."
- :group 'ebrowse-tree
:type 'integer)
(defcustom ebrowse-tree-left-margin 2
"Amount of space left at the left side of the tree display.
This space is used to display markers."
- :group 'ebrowse-tree
:type 'integer)
@@ -126,25 +117,21 @@ This space is used to display markers."
(defcustom ebrowse-default-declaration-column 25
"The column in which member declarations are displayed in member buffers."
- :group 'ebrowse-member
:type 'integer)
(defcustom ebrowse-default-column-width 25
"The width of the columns in member buffers (short display form)."
- :group 'ebrowse-member
:type 'integer)
(defcustom ebrowse-member-buffer-name "*Members*"
"The name of the buffer for member display."
- :group 'ebrowse-member
:type 'string)
(defcustom ebrowse-member-mode-hook nil
"Run in each new member buffer."
- :group 'ebrowse-member
:type 'hook)
@@ -156,81 +143,47 @@ This space is used to display markers."
(defface ebrowse-tree-mark
'((((min-colors 88)) :foreground "red1")
(t :foreground "red"))
- "Face for the mark character in the Ebrowse tree."
- :group 'ebrowse-faces)
+ "Face for the mark character in the Ebrowse tree.")
(defface ebrowse-root-class
'((((min-colors 88)) :weight bold :foreground "blue1")
(t :weight bold :foreground "blue"))
- "Face for root classes in the Ebrowse tree."
- :group 'ebrowse-faces)
+ "Face for root classes in the Ebrowse tree.")
(defface ebrowse-file-name '((t :slant italic))
- "Face for filenames in the Ebrowse tree."
- :group 'ebrowse-faces)
+ "Face for filenames in the Ebrowse tree.")
(defface ebrowse-default '((t))
- "Face for items in the Ebrowse tree which do not have other faces."
- :group 'ebrowse-faces)
+ "Face for items in the Ebrowse tree which do not have other faces.")
(defface ebrowse-member-attribute
'((((min-colors 88)) :foreground "red1")
(t :foreground "red"))
- "Face for member attributes."
- :group 'ebrowse-faces)
+ "Face for member attributes.")
(defface ebrowse-member-class
'((t :foreground "purple"))
- "Face used to display the class title in member buffers."
- :group 'ebrowse-faces)
+ "Face used to display the class title in member buffers.")
(defface ebrowse-progress
'((((min-colors 88)) :background "blue1")
(t :background "blue"))
- "Face for progress indicator."
- :group 'ebrowse-faces)
+ "Face for progress indicator.")
;;; Utilities.
-(defun ebrowse-some (predicate vector)
- "Return true if PREDICATE is true of some element of VECTOR.
-If so, return the value returned by PREDICATE."
- (let ((length (length vector))
- (i 0)
- result)
- (while (and (< i length) (not result))
- (setq result (funcall predicate (aref vector i))
- i (1+ i)))
- result))
+(define-obsolete-function-alias 'ebrowse-some #'seq-some "28.1")
-(defun ebrowse-every (predicate vector)
- "Return true if PREDICATE is true of every element of VECTOR."
- (let ((length (length vector))
- (i 0)
- (result t))
- (while (and (< i length) result)
- (setq result (funcall predicate (aref vector i))
- i (1+ i)))
- result))
+(define-obsolete-function-alias 'ebrowse-every #'seq-every-p "28.1")
(defun ebrowse-position (item list &optional test)
"Return the position of ITEM in LIST or nil if not found.
Compare items with `eq' or TEST if specified."
- (let ((i 0) found)
- (cond (test
- (while list
- (when (funcall test item (car list))
- (setq found i list nil))
- (setq list (cdr list) i (1+ i))))
- (t
- (while list
- (when (eq item (car list))
- (setq found i list nil))
- (setq list (cdr list) i (1+ i)))))
- found))
+ (declare (obsolete seq-position "28.1"))
+ (seq-position list item (or test #'eql)))
(defmacro ebrowse-ignoring-completion-case (&rest body)
@@ -242,17 +195,13 @@ Compare items with `eq' or TEST if specified."
(defmacro ebrowse-for-all-trees (spec &rest body)
"For all trees in SPEC, eval BODY."
(declare (indent 1) (debug ((sexp form) body)))
- (let ((var (make-symbol "var"))
- (spec-var (car spec))
+ (let ((spec-var (car spec))
(array (cadr spec)))
- `(cl-loop for ,var being the symbols of ,array
- as ,spec-var = (get ,var 'ebrowse-root) do
- (when (vectorp ,spec-var)
- ,@body))))
-
-;;; Set indentation for macros above.
-
-
+ `(maphash (lambda (_k ,spec-var)
+ (when ,spec-var
+ (cl-assert (cl-typep ,spec-var 'ebrowse-ts))
+ ,@body))
+ ,array)))
(defsubst ebrowse-set-face (start end face)
"Set face of a region START END to FACE."
@@ -264,8 +213,7 @@ Compare items with `eq' or TEST if specified."
Case is ignored in completions.
PROMPT is a string to prompt with; normally it ends in a colon and a space.
-TABLE is an alist whose elements' cars are strings, or an obarray.
-TABLE can also be a function to do the completion itself.
+TABLE is a completion table.
If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
If it is (STRING . POSITION), the initial input
is STRING, but point is placed POSITION characters into the string."
@@ -304,6 +252,9 @@ otherwise use the current frame's width."
;;; Structure definitions
+;; Note: These use `(:type vector) :named' in order to match the
+;; format used in src/BROWSE.
+
(cl-defstruct (ebrowse-hs (:type vector) :named)
"Header structure found at the head of BROWSE files."
;; A version string that is compared against the version number of
@@ -457,19 +408,17 @@ members."
This must be the same that `ebrowse' uses.")
-(defvar ebrowse--last-regexp nil
+(defvar-local ebrowse--last-regexp nil
"Last regular expression searched for in tree and member buffers.
Each tree and member buffer maintains its own search history.")
-(make-variable-buffer-local 'ebrowse--last-regexp)
-
(defconst ebrowse-member-list-accessors
- '(ebrowse-ts-member-variables
- ebrowse-ts-member-functions
- ebrowse-ts-static-variables
- ebrowse-ts-static-functions
- ebrowse-ts-friends
- ebrowse-ts-types)
+ (list #'ebrowse-ts-member-variables
+ #'ebrowse-ts-member-functions
+ #'ebrowse-ts-static-variables
+ #'ebrowse-ts-static-functions
+ #'ebrowse-ts-friends
+ #'ebrowse-ts-types)
"List of accessors for member lists.
Each element is the symbol of an accessor function.
The nth element must be the accessor for the nth member list
@@ -478,8 +427,8 @@ in an `ebrowse-ts' structure.")
;;; FIXME: Add more doc strings for the buffer-local variables below.
-(defvar ebrowse--tree-obarray nil
- "Obarray holding all `ebrowse-ts' structures of a class tree.
+(defvar ebrowse--tree-table nil
+ "Hash-table holding all `ebrowse-ts' structures of a class tree.
Buffer-local in Ebrowse buffers.")
@@ -637,12 +586,12 @@ Buffer-local in Ebrowse buffers.")
;;; Operations on `ebrowse-ts' structures
(defun ebrowse-files-table (&optional marked-only)
- "Return an obarray containing all files mentioned in the current tree.
-The tree is expected in the buffer-local variable `ebrowse--tree-obarray'.
+ "Return a hash table containing all files mentioned in the current tree.
+The tree is expected in the buffer-local variable `ebrowse--tree-table'.
MARKED-ONLY non-nil means include marked classes only."
(let ((files (make-hash-table :test 'equal))
(i -1))
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(when (or (not marked-only) (ebrowse-ts-mark tree))
(let ((class (ebrowse-ts-class tree)))
(when (zerop (% (cl-incf i) 20))
@@ -677,7 +626,7 @@ MARKED-ONLY non-nil means include marked classes only."
(cl-defun ebrowse-marked-classes-p ()
"Value is non-nil if any class in the current class tree is marked."
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(when (ebrowse-ts-mark tree)
(cl-return-from ebrowse-marked-classes-p tree))))
@@ -695,21 +644,21 @@ MARKED-ONLY non-nil means include marked classes only."
(ebrowse-cs-name class)))
-(defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p)
+(defun ebrowse-tree-table-as-alist (&optional qualified-names-p)
"Return an alist describing all classes in a tree.
Each elements in the list has the form (CLASS-NAME . TREE).
CLASS-NAME is the name of the class. TREE is the
class tree whose root is QUALIFIED-CLASS-NAME.
QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME.
-The class tree is found in the buffer-local variable `ebrowse--tree-obarray'."
+The class tree is found in the buffer-local variable `ebrowse--tree-table'."
(let (alist)
(if qualified-names-p
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(setq alist
(cl-acons (ebrowse-qualified-class-name
(ebrowse-ts-class tree))
tree alist)))
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(setq alist
(cl-acons (ebrowse-cs-name (ebrowse-ts-class tree))
tree alist))))
@@ -751,7 +700,7 @@ computes this information lazily."
with result = nil
as search = (pop to-search)
while search finally return result
- do (ebrowse-for-all-trees (ti ebrowse--tree-obarray)
+ do (ebrowse-for-all-trees (ti ebrowse--tree-table)
(when (memq search (ebrowse-ts-subclasses ti))
(unless (memq ti result)
(setq result (nconc result (list ti))))
@@ -875,7 +824,7 @@ NOCONFIRM."
"Create a new tree buffer for tree TREE.
The tree was loaded from file TAGS-FILE.
HEADER is the header structure of the file.
-CLASSES is an obarray with a symbol for each class in the tree.
+CLASSES is a hash-table with an entry for each class in the tree.
POP non-nil means popup the buffer up at the end.
Return the buffer created."
(let ((name ebrowse-tree-buffer-name))
@@ -883,7 +832,7 @@ Return the buffer created."
(ebrowse-tree-mode)
(setq ebrowse--tree tree
ebrowse--tags-file-name tags-file
- ebrowse--tree-obarray classes
+ ebrowse--tree-table classes
ebrowse--header header
ebrowse--frozen-flag nil)
(ebrowse-redraw-tree)
@@ -895,13 +844,13 @@ Return the buffer created."
-;;; Operations for member obarrays
+;;; Operations for member tables
(defun ebrowse-fill-member-table ()
- "Return an obarray holding all members of all classes in the current tree.
+ "Return a hash table holding all members of all classes in the current tree.
-For each member, a symbol is added to the obarray. Members are
-extracted from the buffer-local tree `ebrowse--tree-obarray'.
+For each member, a symbol is added to the table. Members are
+extracted from the buffer-local tree `ebrowse--tree-table'.
Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST
MEMBER) where TREE is the tree in which the member is defined,
@@ -909,26 +858,23 @@ MEMBER-LIST is a symbol describing the member list in which the member
is found, and MEMBER is a MEMBER structure describing the member.
The slot `member-table' of the buffer-local header structure of
-type `ebrowse-hs' is set to the resulting obarray."
+type `ebrowse-hs' is set to the resulting table."
(let ((members (make-hash-table :test 'equal))
(i -1))
(setf (ebrowse-hs-member-table ebrowse--header) nil)
(garbage-collect)
;; For all classes...
- (ebrowse-for-all-trees (c ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (c ebrowse--tree-table)
(when (zerop (% (cl-incf i) 10))
(ebrowse-show-progress "Preparing member lookup" (zerop i)))
(dolist (f ebrowse-member-list-accessors)
(dolist (m (funcall f c))
- (let* ((member-name (ebrowse-ms-name m))
- (value (gethash member-name members)))
- (push (list c f m) value)
- (puthash member-name value members)))))
+ (push (list c f m) (gethash (ebrowse-ms-name m) members)))))
(setf (ebrowse-hs-member-table ebrowse--header) members)))
(defun ebrowse-member-table (header)
- "Return the member obarray. Build it if it hasn't been set up yet.
+ "Return the member table. Build it if it hasn't been set up yet.
HEADER is the tree header structure of the class tree."
(when (null (ebrowse-hs-member-table header))
(cl-loop for buffer in (ebrowse-browser-buffer-list)
@@ -940,19 +886,18 @@ HEADER is the tree header structure of the class tree."
-;;; Operations on TREE obarrays
+;;; Operations on TREE tables
-(defun ebrowse-build-tree-obarray (tree)
+(defun ebrowse-build-tree-table (tree)
"Make sure every class in TREE is represented by a unique object.
-Build obarray of all classes in TREE."
- (let ((classes (make-vector 127 0)))
+Build hash table of all classes in TREE."
+ (let ((classes (make-hash-table :test #'equal)))
;; Add root classes...
(cl-loop for root in tree
- as sym =
- (intern (ebrowse-qualified-class-name (ebrowse-ts-class root))
- classes)
- do (unless (get sym 'ebrowse-root)
- (setf (get sym 'ebrowse-root) root)))
+ do (let ((name (ebrowse-qualified-class-name
+ (ebrowse-ts-class root))))
+ (unless (gethash name classes)
+ (setf (gethash name classes) root))))
;; Process subclasses
(ebrowse-insert-supers tree classes)
classes))
@@ -962,7 +907,7 @@ Build obarray of all classes in TREE."
"Build base class lists in class tree TREE.
CLASSES is an obarray used to collect classes.
-Helper function for `ebrowse-build-tree-obarray'. Base classes should
+Helper function for `ebrowse-build-tree-table'. Base classes should
be ordered so that immediate base classes come first, then the base
class of the immediate base class and so on. This means that we must
construct the base-class list top down with adding each level at the
@@ -974,23 +919,21 @@ if for some reason a circle is in the inheritance graph."
as subclasses = (ebrowse-ts-subclasses class) do
;; Make sure every class is represented by a unique object
(cl-loop for subclass on subclasses
- as sym = (intern
- (ebrowse-qualified-class-name
- (ebrowse-ts-class (car subclass)))
- classes)
do
- ;; Replace the subclass tree with the one found in
- ;; CLASSES if there is already an entry for that class
- ;; in it. Otherwise make a new entry.
- ;;
- ;; CAVEAT: If by some means (e.g., use of the
- ;; preprocessor in class declarations, a name is marked
- ;; as a subclass of itself on some path, we would end up
- ;; in an endless loop. We have to omit subclasses from
- ;; the recursion that already have been processed.
- (if (get sym 'ebrowse-root)
- (setf (car subclass) (get sym 'ebrowse-root))
- (setf (get sym 'ebrowse-root) (car subclass))))
+ (let ((name (ebrowse-qualified-class-name
+ (ebrowse-ts-class (car subclass)))))
+ ;; Replace the subclass tree with the one found in
+ ;; CLASSES if there is already an entry for that class
+ ;; in it. Otherwise make a new entry.
+ ;;
+ ;; CAVEAT: If by some means (e.g., use of the
+ ;; preprocessor in class declarations, a name is marked
+ ;; as a subclass of itself on some path, we would end up
+ ;; in an endless loop. We have to omit subclasses from
+ ;; the recursion that already have been processed.
+ (if (gethash name classes)
+ (setf (car subclass) (gethash name classes))
+ (setf (gethash name classes) (car subclass)))))
;; Process subclasses
(ebrowse-insert-supers subclasses classes)))
@@ -1072,20 +1015,17 @@ Tree mode key bindings:
(erase-buffer)
(message nil))
- (set (make-local-variable 'ebrowse--show-file-names-flag) nil)
- (set (make-local-variable 'ebrowse--tree-obarray) (make-vector 127 0))
- (set (make-local-variable 'ebrowse--frozen-flag) nil)
+ (setq-local ebrowse--show-file-names-flag nil)
+ (setq-local ebrowse--frozen-flag nil)
(setq mode-line-buffer-identification ident)
(setq buffer-read-only t)
(add-to-invisibility-spec '(ebrowse . t))
- (set (make-local-variable 'revert-buffer-function)
- #'ebrowse-revert-tree-buffer-from-file)
- (set (make-local-variable 'ebrowse--header) header)
- (set (make-local-variable 'ebrowse--tree) tree)
- (set (make-local-variable 'ebrowse--tags-file-name) buffer-file-name)
- (set (make-local-variable 'ebrowse--tree-obarray)
- (and tree (ebrowse-build-tree-obarray tree)))
- (set (make-local-variable 'ebrowse--frozen-flag) nil)
+ (setq-local revert-buffer-function #'ebrowse-revert-tree-buffer-from-file)
+ (setq-local ebrowse--header header)
+ (setq-local ebrowse--tree tree)
+ (setq-local ebrowse--tags-file-name buffer-file-name)
+ (setq-local ebrowse--tree-table (and tree (ebrowse-build-tree-table tree)))
+ (setq-local ebrowse--frozen-flag nil)
(add-hook 'write-file-functions #'ebrowse-write-file-hook-fn nil t)
(modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))
@@ -1110,18 +1050,18 @@ Tree mode key bindings:
(defun ebrowse-remove-class-and-kill-member-buffers (tree class)
"Remove from TREE class CLASS.
Kill all member buffers still containing a reference to the class."
- (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class))
- ebrowse--tree-obarray)))
- (setf tree (delq class tree)
- (get sym 'ebrowse-root) nil)
- (dolist (root tree)
- (setf (ebrowse-ts-subclasses root)
- (delq class (ebrowse-ts-subclasses root))
- (ebrowse-ts-base-classes root) nil)
- (ebrowse-remove-class-and-kill-member-buffers
- (ebrowse-ts-subclasses root) class))
- (ebrowse-kill-member-buffers-displaying class)
- tree))
+ (setf tree (delq class tree)
+ (gethash (ebrowse-cs-name (ebrowse-ts-class class))
+ ebrowse--tree-table)
+ nil)
+ (dolist (root tree)
+ (setf (ebrowse-ts-subclasses root)
+ (delq class (ebrowse-ts-subclasses root))
+ (ebrowse-ts-base-classes root) nil)
+ (ebrowse-remove-class-and-kill-member-buffers
+ (ebrowse-ts-subclasses root) class))
+ (ebrowse-kill-member-buffers-displaying class)
+ tree)
(defun ebrowse-remove-class-at-point (forced)
@@ -1184,7 +1124,7 @@ If given a numeric N-TIMES argument, mark that many classes."
(defun ebrowse-mark-all-classes (prefix)
"Unmark, with PREFIX mark, all classes in the tree."
(interactive "P")
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(setf (ebrowse-ts-mark tree) prefix))
(ebrowse-redraw-marks (point-min) (point-max)))
@@ -1277,17 +1217,17 @@ With PREFIX, insert that many filenames."
(defun ebrowse-browser-buffer-list ()
"Return a list of all tree or member buffers."
- (cl-delete-if-not 'ebrowse-buffer-p (buffer-list)))
+ (cl-delete-if-not #'ebrowse-buffer-p (buffer-list)))
(defun ebrowse-member-buffer-list ()
"Return a list of all member buffers."
- (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list)))
+ (cl-delete-if-not #'ebrowse-member-buffer-p (buffer-list)))
(defun ebrowse-tree-buffer-list ()
"Return a list of all tree buffers."
- (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list)))
+ (cl-delete-if-not #'ebrowse-tree-buffer-p (buffer-list)))
(defun ebrowse-known-class-trees-buffer-list ()
@@ -1396,7 +1336,7 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise."
"): ")
nil nil ebrowse--indentation))))
(when (cl-plusp width)
- (set (make-local-variable 'ebrowse--indentation) width)
+ (setq-local ebrowse--indentation width)
(ebrowse-redraw-tree))))
@@ -1409,7 +1349,7 @@ Read a class name from the minibuffer if CLASS is nil."
(unless class
(setf class
(completing-read "Goto class: "
- (ebrowse-tree-obarray-as-alist) nil t)))
+ (ebrowse-tree-table-as-alist) nil t)))
(goto-char (point-min))
(widen)
(setq ebrowse--last-regexp (concat "\\b" class "\\b"))
@@ -1426,37 +1366,37 @@ Read a class name from the minibuffer if CLASS is nil."
(defun ebrowse-tree-command:show-member-variables (arg)
"Display member variables; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-member-variables arg))
(defun ebrowse-tree-command:show-member-functions (&optional arg)
"Display member functions; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-member-functions arg))
(defun ebrowse-tree-command:show-static-member-variables (arg)
"Display static member variables; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-static-variables arg))
(defun ebrowse-tree-command:show-static-member-functions (arg)
"Display static member functions; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-static-functions arg))
(defun ebrowse-tree-command:show-friends (arg)
"Display friend functions; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-friends arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-friends arg))
(defun ebrowse-tree-command:show-types (arg)
"Display types defined in a class; with prefix ARG in frozen member buffer."
(interactive "P")
- (ebrowse-display-member-buffer 'ebrowse-ts-types arg))
+ (ebrowse-display-member-buffer #'ebrowse-ts-types arg))
@@ -1562,12 +1502,12 @@ The new frame is deleted when you quit viewing the file in that frame."
(had-a-buf (get-file-buffer file))
(buf-to-view (find-file-noselect file)))
(switch-to-buffer-other-frame buf-to-view)
- (set (make-local-variable 'ebrowse--frame-configuration)
+ (setq-local ebrowse--frame-configuration
old-frame-configuration)
- (set (make-local-variable 'ebrowse--view-exit-action)
+ (setq-local ebrowse--view-exit-action
(and (not had-a-buf)
(not (buffer-modified-p buf-to-view))
- 'kill-buffer))
+ #'kill-buffer))
(view-mode-enter (cons (selected-window) (cons (selected-window) t))
'ebrowse-view-exit-fn)))
@@ -1934,7 +1874,7 @@ COLLAPSE non-nil means collapse the branch."
(when (memq 'mode-name mode-line-format)
(setq mode-line-format (copy-sequence mode-line-format))
(setcar (memq 'mode-name mode-line-format) "Tree Buffers"))
- (set (make-local-variable 'Helper-return-blurb) "return to buffer editing")
+ (setq-local Helper-return-blurb "return to buffer editing")
(setq truncate-lines t
buffer-read-only t))
@@ -2145,41 +2085,31 @@ See `Electric-command-loop' for a description of STATE and CONDITION."
(define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members"
"Major mode for Ebrowse member buffers."
(mapc #'make-local-variable
- '(ebrowse--decl-column ;display column
- ebrowse--n-columns ;number of short columns
- ebrowse--column-width ;width of columns above
- ebrowse--show-inherited-flag ;include inherited members?
- ebrowse--filters ;public, protected, private
+ '(ebrowse--n-columns ;number of short columns
ebrowse--accessor ;vars, functions, friends
ebrowse--displayed-class ;class displayed
- ebrowse--long-display-flag ;display with regexps?
- ebrowse--source-regexp-flag ;show source regexp?
- ebrowse--attributes-flag ;show `virtual' and `inline'
ebrowse--member-list ;list of members displayed
ebrowse--tree ;the class tree
ebrowse--member-mode-strings ;part of mode line
ebrowse--tags-file-name ;
ebrowse--header
- ebrowse--tree-obarray
- ebrowse--virtual-display-flag
- ebrowse--inline-display-flag
- ebrowse--const-display-flag
- ebrowse--pure-display-flag
+ ebrowse--tree-table
ebrowse--frozen-flag)) ;buffer not automagically reused
- (setq mode-line-buffer-identification
- (propertized-buffer-identification "C++ Members")
- buffer-read-only t
- ebrowse--long-display-flag nil
- ebrowse--attributes-flag t
- ebrowse--show-inherited-flag t
- ebrowse--source-regexp-flag nil
- ebrowse--filters [0 1 2]
- ebrowse--decl-column ebrowse-default-declaration-column
- ebrowse--column-width ebrowse-default-column-width
- ebrowse--virtual-display-flag nil
- ebrowse--inline-display-flag nil
- ebrowse--const-display-flag nil
- ebrowse--pure-display-flag nil)
+ (setq-local
+ mode-line-buffer-identification
+ (propertized-buffer-identification "C++ Members")
+ buffer-read-only t
+ ebrowse--long-display-flag nil ;display with regexps?
+ ebrowse--attributes-flag t ;show `virtual' and `inline'
+ ebrowse--show-inherited-flag t ;include inherited members?
+ ebrowse--source-regexp-flag nil ;show source regexp?
+ ebrowse--filters [0 1 2] ;public, protected, private
+ ebrowse--decl-column ebrowse-default-declaration-column ;display column
+ ebrowse--column-width ebrowse-default-column-width ;width of columns above
+ ebrowse--virtual-display-flag nil
+ ebrowse--inline-display-flag nil
+ ebrowse--const-display-flag nil
+ ebrowse--pure-display-flag nil)
(modify-syntax-entry ?_ (char-to-string (char-syntax ?a))))
@@ -2257,10 +2187,10 @@ make one."
(ebrowse-create-tree-buffer ebrowse--tree
ebrowse--tags-file-name
ebrowse--header
- ebrowse--tree-obarray
+ ebrowse--tree-table
'pop))))
(and buf
- (funcall (if arg 'switch-to-buffer 'pop-to-buffer) buf))
+ (funcall (if arg #'switch-to-buffer #'pop-to-buffer) buf))
buf))
@@ -2276,8 +2206,9 @@ make one."
(defun ebrowse-cyclic-display-next/previous-member-list (incr)
"Switch buffer to INCR'th next/previous list of members."
- (let ((index (ebrowse-position ebrowse--accessor
- ebrowse-member-list-accessors)))
+ (let ((index (seq-position ebrowse-member-list-accessors
+ ebrowse--accessor
+ #'eql)))
(setf ebrowse--accessor
(cond ((cl-plusp incr)
(or (nth (1+ index)
@@ -2306,37 +2237,37 @@ make one."
(defun ebrowse-display-function-member-list ()
"Display the list of member functions."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-functions))
(defun ebrowse-display-variables-member-list ()
"Display the list of member variables."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-variables))
(defun ebrowse-display-static-variables-member-list ()
"Display the list of static member variables."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-variables))
(defun ebrowse-display-static-functions-member-list ()
"Display the list of static member functions."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-functions))
(defun ebrowse-display-friends-member-list ()
"Display the list of friends."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-friends))
(defun ebrowse-display-types-member-list ()
"Display the list of types."
(interactive)
- (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types))
+ (ebrowse-display-member-list-for-accessor #'ebrowse-ts-types))
@@ -2565,8 +2496,8 @@ TAGS-FILE is the file name of the BROWSE file."
"Force buffer redisplay."
(interactive)
(let ((display-fn (if ebrowse--long-display-flag
- 'ebrowse-draw-member-long-fn
- 'ebrowse-draw-member-short-fn)))
+ #'ebrowse-draw-member-long-fn
+ #'ebrowse-draw-member-short-fn)))
(with-silent-modifications
(erase-buffer)
;; Show this class
@@ -2610,7 +2541,7 @@ the class cursor is on."
"Start point for member buffer creation.
LIST is the member list to display. STAND-ALONE non-nil
means the member buffer is standalone. CLASS is its class."
- (let* ((classes ebrowse--tree-obarray)
+ (let* ((classes ebrowse--tree-table)
(tree ebrowse--tree)
(tags-file ebrowse--tags-file-name)
(header ebrowse--header)
@@ -2630,7 +2561,7 @@ means the member buffer is standalone. CLASS is its class."
(setq ebrowse--member-list (funcall list class)
ebrowse--displayed-class class
ebrowse--accessor list
- ebrowse--tree-obarray classes
+ ebrowse--tree-table classes
ebrowse--frozen-flag stand-alone
ebrowse--tags-file-name tags-file
ebrowse--header header
@@ -2842,7 +2773,7 @@ REPEAT, if specified, says repeat the search REPEAT times."
(cl-defun ebrowse-move-point-to-member (name &optional count &aux member)
- "Set point on member NAME in the member buffer
+ "Set point on member NAME in the member buffer.
COUNT, if specified, says search the COUNT'th member with the same name."
(goto-char (point-min))
(widen)
@@ -2867,7 +2798,8 @@ COMPL-LIST is a completion list to use."
(class (or (ebrowse-completing-read-value title compl-list initial)
(error "Not found"))))
(setf ebrowse--displayed-class class
- ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class))
+ ebrowse--member-list (funcall ebrowse--accessor
+ ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer)))
@@ -2875,7 +2807,9 @@ COMPL-LIST is a completion list to use."
"Switch member buffer to a class read from the minibuffer."
(interactive)
(ebrowse-switch-member-buffer-to-other-class
- "Goto class: " (ebrowse-tree-obarray-as-alist)))
+ "Goto class: "
+ ;; FIXME: Why not use the hash-table as-is?
+ (ebrowse-tree-table-as-alist)))
(defun ebrowse-switch-member-buffer-to-base-class (arg)
@@ -2927,8 +2861,9 @@ Prefix arg INC specifies which one."
(cl-first supers))))
(unless tree (error "Not found"))
(setq containing-list (ebrowse-ts-subclasses tree)))))
- (setq index (+ inc (ebrowse-position ebrowse--displayed-class
- containing-list)))
+ (setq index (+ inc (seq-position containing-list
+ ebrowse--displayed-class
+ #'eql)))
(cond ((cl-minusp index) (message "No previous class"))
((null (nth index containing-list)) (message "No next class")))
(setq index (max 0 (min index (1- (length containing-list)))))
@@ -2943,16 +2878,16 @@ Prefix arg INC specifies which one."
Prefix arg ARG says which class should be displayed. Default is
the first derived class."
(interactive "P")
- (cl-flet ((ebrowse-tree-obarray-as-alist ()
+ (cl-flet ((ebrowse-tree-table-as-alist ()
(cl-loop for s in (ebrowse-ts-subclasses
ebrowse--displayed-class)
- collect (cons (ebrowse-cs-name
- (ebrowse-ts-class s)) s))))
+ collect (cons (ebrowse-cs-name (ebrowse-ts-class s))
+ s))))
(let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class)
(error "No derived classes"))))
(if (and arg (cl-second subs))
(ebrowse-switch-member-buffer-to-other-class
- "Goto derived class: " (ebrowse-tree-obarray-as-alist))
+ "Goto derived class: " (ebrowse-tree-table-as-alist))
(setq ebrowse--displayed-class (cl-first subs)
ebrowse--member-list
(funcall ebrowse--accessor ebrowse--displayed-class))
@@ -3403,7 +3338,8 @@ It is a list (TREE ACCESSOR MEMBER)."
(switch-to-buffer buffer)
(setq ebrowse--displayed-class (cl-first info)
ebrowse--accessor (cl-second info)
- ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class))
+ ebrowse--member-list (funcall ebrowse--accessor
+ ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer)))
(ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info)))))
@@ -3513,28 +3449,20 @@ KIND is an additional string printed in the buffer."
(_ "unknown"))
"\n")))
-(defvar ebrowse-last-completion nil
+(defvar-local ebrowse-last-completion nil
"Text inserted by the last completion operation.")
-(defvar ebrowse-last-completion-start nil
+(defvar-local ebrowse-last-completion-start nil
"String which was the basis for the last completion operation.")
-(defvar ebrowse-last-completion-location nil
+(defvar-local ebrowse-last-completion-location nil
"Buffer position at which the last completion operation was initiated.")
-(defvar ebrowse-last-completion-obarray nil
+(defvar-local ebrowse-last-completion-table nil
"Member used in last completion operation.")
-
-
-(make-variable-buffer-local 'ebrowse-last-completion-obarray)
-(make-variable-buffer-local 'ebrowse-last-completion-location)
-(make-variable-buffer-local 'ebrowse-last-completion)
-(make-variable-buffer-local 'ebrowse-last-completion-start)
-
-
(defun ebrowse-some-member-table ()
"Return a hash table containing all members of a tree.
@@ -3552,7 +3480,7 @@ use choose a tree."
(defun ebrowse-cyclic-successor-in-string-list (string list)
"Return the item following STRING in LIST.
If STRING is the last element, return the first element as successor."
- (or (nth (1+ (ebrowse-position string list 'string=)) list)
+ (or (nth (1+ (seq-position list string #'string=)) list)
(cl-first list)))
@@ -3583,7 +3511,7 @@ completion."
;; expansion ended, insert the next expansion.
((eq (point) ebrowse-last-completion-location)
(setf list (all-completions ebrowse-last-completion-start
- ebrowse-last-completion-obarray)
+ ebrowse-last-completion-table)
completion (ebrowse-cyclic-successor-in-string-list
ebrowse-last-completion list))
(cond ((null completion)
@@ -3599,7 +3527,7 @@ completion."
;; buffer: Start new completion.
(t
(let* ((members (ebrowse-some-member-table))
- (completion (cl-first (all-completions pattern members nil))))
+ (completion (cl-first (all-completions pattern members))))
(cond ((eq completion t))
((null completion)
(error "Can't find completion for `%s'" pattern))
@@ -3610,14 +3538,14 @@ completion."
(setf ebrowse-last-completion-location (point)
ebrowse-last-completion-start pattern
ebrowse-last-completion completion
- ebrowse-last-completion-obarray members))))))))
+ ebrowse-last-completion-table members))))))))
;;; Tags query replace & search
-(defvar ebrowse-tags-loop-form ()
- "Form for `ebrowse-tags-loop-continue'.
-Evaluated for each file in the tree. If it returns nil, proceed
+(defvar ebrowse-tags-loop-call '(ignore)
+ "Function call for `ebrowse-tags-loop-continue'.
+Passed to `apply' for each file in the tree. If it returns nil, proceed
with the next file.")
(defvar ebrowse-tags-next-file-list ()
@@ -3684,7 +3612,7 @@ TREE-BUFFER if indirectly specifies which files to loop over."
(when first-time
(ebrowse-tags-next-file first-time tree-buffer)
(goto-char (point-min)))
- (while (not (eval ebrowse-tags-loop-form))
+ (while (not (apply ebrowse-tags-loop-call))
(ebrowse-tags-next-file)
(message "Scanning file `%s'..." buffer-file-name)
(goto-char (point-min))))
@@ -3697,9 +3625,9 @@ If marked classes exist, process marked classes, only.
If regular expression is nil, repeat last search."
(interactive "sTree search (regexp): ")
(if (and (string= regexp "")
- (eq (car ebrowse-tags-loop-form) 're-search-forward))
+ (eq (car ebrowse-tags-loop-call) #'re-search-forward))
(ebrowse-tags-loop-continue)
- (setq ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
+ (setq ebrowse-tags-loop-call `(re-search-forward ,regexp nil t))
(ebrowse-tags-loop-continue 'first-time)))
@@ -3709,10 +3637,11 @@ If regular expression is nil, repeat last search."
With prefix arg, process files of marked classes only."
(interactive
"sTree query replace (regexp): \nsTree query replace %s by: ")
- (setq ebrowse-tags-loop-form
- (list 'and (list 'save-excursion
- (list 're-search-forward from nil t))
- (list 'not (list 'perform-replace from to t t nil))))
+ (setq ebrowse-tags-loop-call
+ (list (lambda ()
+ (and (save-excursion
+ (re-search-forward from nil t))
+ (not (perform-replace from to t t nil))))))
(ebrowse-tags-loop-continue 'first-time))
@@ -3737,7 +3666,7 @@ looks like a function call to the member."
(cl-values-list (ebrowse-tags-read-name header "Find calls of: "))))
;; Set tags loop form to search for member and begin loop.
(setq regexp (concat "\\<" name "[ \t]*(")
- ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
+ ebrowse-tags-loop-call `(re-search-forward ,regexp nil t))
(ebrowse-tags-loop-continue 'first-time tree-buffer))))
@@ -3746,7 +3675,7 @@ looks like a function call to the member."
;;; Structures of this kind are the elements of the position stack.
-(cl-defstruct (ebrowse-position (:type vector) :named)
+(cl-defstruct (ebrowse-position)
file-name ; in which file
point ; point in file
target ; t if target of a jump
@@ -3839,18 +3768,10 @@ Prefix arg ARG says how much."
;;; Electric position list
-(defvar ebrowse-electric-position-mode-map ()
- "Keymap used in electric position stack window.")
-
-
-(defvar ebrowse-electric-position-mode-hook nil
- "If non-nil, its value is called by `ebrowse-electric-position-mode'.")
-
-
-(unless ebrowse-electric-position-mode-map
+(defvar ebrowse-electric-position-mode-map
(let ((map (make-keymap))
(submap (make-keymap)))
- (setq ebrowse-electric-position-mode-map map)
+ ;; FIXME: Yuck!
(fillarray (car (cdr map)) 'ebrowse-electric-position-undefined)
(fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined)
(define-key map "\e" submap)
@@ -3873,14 +3794,19 @@ Prefix arg ARG says how much."
(define-key map "\e\C-v" 'scroll-other-window)
(define-key map "\e>" 'end-of-buffer)
(define-key map "\e<" 'beginning-of-buffer)
- (define-key map "\e>" 'end-of-buffer)))
+ (define-key map "\e>" 'end-of-buffer)
+ map)
+ "Keymap used in electric position stack window.")
+
+
+(defvar ebrowse-electric-position-mode-hook nil
+ "If non-nil, its value is called by `ebrowse-electric-position-mode'.")
-(put 'ebrowse-electric-position-mode 'mode-class 'special)
(put 'ebrowse-electric-position-undefined 'suppress-keymap t)
(define-derived-mode ebrowse-electric-position-mode
- fundamental-mode "Electric Position Menu"
+ special-mode "Electric Position Menu"
"Mode for electric position buffers.
Runs the hook `ebrowse-electric-position-mode-hook'."
(setq mode-line-buffer-identification "Electric Position Menu")
@@ -3888,7 +3814,7 @@ Runs the hook `ebrowse-electric-position-mode-hook'."
(setq mode-line-format (copy-sequence mode-line-format))
;; FIXME: Why not set `mode-name' to "Positions"?
(setcar (memq 'mode-name mode-line-format) "Positions"))
- (set (make-local-variable 'Helper-return-blurb) "return to buffer editing")
+ (setq-local Helper-return-blurb "return to buffer editing")
(setq truncate-lines t
buffer-read-only t))
@@ -4101,7 +4027,7 @@ NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS
NUMBER-OF-STATIC-VARIABLES:"
(let ((classes 0) (member-functions 0) (member-variables 0)
(static-functions 0) (static-variables 0))
- (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
+ (ebrowse-for-all-trees (tree ebrowse--tree-table)
(cl-incf classes)
(cl-incf member-functions (length (ebrowse-ts-member-functions tree)))
(cl-incf member-variables (length (ebrowse-ts-member-variables tree)))
@@ -4391,10 +4317,4 @@ EVENT is the mouse event."
(provide 'ebrowse)
-
-;; Local variables:
-;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
-;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
-;; End:
-
;;; ebrowse.el ends here
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index f39ecf9b7bc..12788eacf1b 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -196,7 +196,8 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
(if (and (buffer-modified-p)
(y-or-n-p (format "Save buffer %s first? " (buffer-name))))
(save-buffer))
- (byte-recompile-file buffer-file-name nil 0 t))
+ (byte-recompile-file buffer-file-name nil 0)
+ (load buffer-file-name))
(defun emacs-lisp-macroexpand ()
"Macroexpand the form after point.
@@ -231,8 +232,35 @@ Comments in the form will be lost."
(setq-local electric-pair-text-pairs elisp-pairs)))))
(remove-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
+(defun elisp-enable-lexical-binding (&optional interactive)
+ "Make the current buffer use `lexical-binding'."
+ (interactive "p")
+ (if lexical-binding
+ (when interactive
+ (message "lexical-binding already enabled!")
+ (ding))
+ (when (or (not interactive)
+ (y-or-n-p (format "Enable lexical-binding in this %s? "
+ (if buffer-file-name "file" "buffer"))))
+ (setq-local lexical-binding t)
+ (add-file-local-variable-prop-line 'lexical-binding t interactive))))
+
+(defvar elisp--dynlex-modeline-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line mouse-1] 'elisp-enable-lexical-binding)
+ map))
+
;;;###autoload
-(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
+(define-derived-mode emacs-lisp-mode lisp-data-mode
+ `("ELisp"
+ (lexical-binding (:propertize "/l"
+ help-echo "Using lexical-binding mode")
+ (:propertize "/d"
+ help-echo "Using old dynamic scoping mode\n\
+mouse-1: Enable lexical-binding mode"
+ face warning
+ mouse-face mode-line-highlight
+ local-map ,elisp--dynlex-modeline-map)))
"Major mode for editing Lisp code to run in Emacs.
Commands:
Delete converts tabs to spaces as it moves back.
@@ -241,35 +269,28 @@ Blank lines separate paragraphs. Semicolons start comments.
\\{emacs-lisp-mode-map}"
:group 'lisp
(defvar project-vc-external-roots-function)
- (lisp-mode-variables nil nil 'elisp)
+ (setcar font-lock-defaults
+ '(lisp-el-font-lock-keywords
+ lisp-el-font-lock-keywords-1
+ lisp-el-font-lock-keywords-2))
+ (setf (nth 2 font-lock-defaults) nil)
(add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
(if (boundp 'electric-pair-text-pairs)
(setq-local electric-pair-text-pairs
- (append '((?\` . ?\') (?‘ . ?’))
+ (append '((?\` . ?\') (?\‘ . ?\’))
electric-pair-text-pairs))
(add-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
- (setq-local electric-quote-string t)
- (setq imenu-case-fold-search nil)
- (add-function :before-until (local 'eldoc-documentation-function)
- #'elisp-eldoc-documentation-function)
+ (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-funcall nil t)
+ (add-hook 'eldoc-documentation-functions
+ #'elisp-eldoc-var-docstring nil t)
(add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
(setq-local project-vc-external-roots-function #'elisp-load-path-roots)
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil 'local)
- ;; .dir-locals.el and lock files will cause the byte-compiler and
- ;; checkdoc emit spurious warnings, because they don't follow the
- ;; conventions of Emacs Lisp sources. Until we have a better fix,
- ;; like teaching elisp-mode about files that only hold data
- ;; structures, we disable the ELisp Flymake backend for these files.
- (unless
- (let* ((bfname (buffer-file-name))
- (fname (and (stringp bfname) (file-name-nondirectory bfname))))
- (and (stringp fname)
- (or (string-match "\\`\\.#" fname)
- (string-equal dir-locals-file fname))))
- (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
- (add-hook 'flymake-diagnostic-functions
- #'elisp-flymake-byte-compile nil t)))
+ (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
+ (add-hook 'flymake-diagnostic-functions
+ #'elisp-flymake-byte-compile nil t))
;; Font-locking support.
@@ -637,18 +658,16 @@ functions are annotated with \"<f>\" via the
;; WORKAROUND: This is nominally a constant, but the text properties
;; are not preserved thru dump if use defconst. See bug#21237.
(defvar elisp--xref-format
- (let ((str "(%s %s)"))
- (put-text-property 1 3 'face 'font-lock-keyword-face str)
- (put-text-property 4 6 'face 'font-lock-function-name-face str)
- str))
+ #("(%s %s)"
+ 1 3 (face font-lock-keyword-face)
+ 4 6 (face font-lock-function-name-face)))
;; WORKAROUND: This is nominally a constant, but the text properties
;; are not preserved thru dump if use defconst. See bug#21237.
(defvar elisp--xref-format-extra
- (let ((str "(%s %s %s)"))
- (put-text-property 1 3 'face 'font-lock-keyword-face str)
- (put-text-property 4 6 'face 'font-lock-function-name-face str)
- str))
+ #("(%s %s %s)"
+ 1 3 (face font-lock-keyword-face)
+ 4 6 (face font-lock-function-name-face)))
(defvar find-feature-regexp);; in find-func.el
@@ -665,7 +684,7 @@ otherwise build the summary from TYPE and SYMBOL."
"List of functions to be run from `elisp--xref-find-definitions' to add additional xrefs.
Called with one arg; the symbol whose definition is desired.
Each function should return a list of xrefs, or nil; the first
-non-nil result supercedes the xrefs produced by
+non-nil result supersedes the xrefs produced by
`elisp--xref-find-definitions'.")
(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
@@ -845,11 +864,12 @@ non-nil result supercedes the xrefs produced by
xrefs))
-(declare-function project-external-roots "project")
+(declare-function xref-apropos-regexp "xref" (pattern))
-(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) regexp)
+(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) pattern)
(apply #'nconc
- (let (lst)
+ (let ((regexp (xref-apropos-regexp pattern))
+ lst)
(dolist (sym (apropos-internal regexp))
(push (elisp--xref-find-definitions sym) lst))
(nreverse lst))))
@@ -877,8 +897,10 @@ non-nil result supercedes the xrefs produced by
(let ((buffer-point (find-function-search-for-symbol symbol type file)))
(with-current-buffer (car buffer-point)
(save-excursion
- (goto-char (or (cdr buffer-point) (point-min)))
- (point-marker))))))
+ (save-restriction
+ (widen)
+ (goto-char (or (cdr buffer-point) (point-min)))
+ (point-marker)))))))
(cl-defmethod xref-location-group ((l xref-elisp-location))
(xref-elisp-location-file l))
@@ -1171,7 +1193,8 @@ character)."
;; Setup the lexical environment if lexical-binding is enabled.
(elisp--eval-last-sexp-print-value
(eval (macroexpand-all
- (eval-sexp-add-defvars (elisp--preceding-sexp)))
+ (eval-sexp-add-defvars
+ (elisp--eval-defun-1 (macroexpand (elisp--preceding-sexp)))))
lexical-binding)
(if insert-value (current-buffer) t) no-truncate char-print-limit)))
@@ -1227,6 +1250,10 @@ POS specifies the starting position where EXP was found and defaults to point."
Interactively, with a non `-' prefix argument, print output into
current buffer.
+This commands handles `defvar', `defcustom' and `defface' the
+same way that `eval-defun' does. See the doc string of that
+function for details.
+
Normally, this function truncates long output according to the
value of the variables `eval-expression-print-length' and
`eval-expression-print-level'. With a prefix argument of zero,
@@ -1386,20 +1413,54 @@ which see."
or argument string for functions.
2 - `function' if function args, `variable' if variable documentation.")
-(defun elisp-eldoc-documentation-function ()
- "`eldoc-documentation-function' (which see) for Emacs Lisp."
- (let ((current-symbol (elisp--current-symbol))
- (current-fnsym (elisp--fnsym-in-current-sexp)))
- (cond ((null current-fnsym)
- nil)
- ((eq current-symbol (car current-fnsym))
- (or (apply #'elisp-get-fnsym-args-string current-fnsym)
- (elisp-get-var-docstring current-symbol)))
- (t
- (or (elisp-get-var-docstring current-symbol)
- (apply #'elisp-get-fnsym-args-string current-fnsym))))))
-
-(defun elisp-get-fnsym-args-string (sym &optional index prefix)
+(defun elisp--documentation-one-liner ()
+ (let* (str
+ (callback (lambda (doc &rest plist)
+ (when doc
+ (setq str
+ (format "%s: %s"
+ (propertize (prin1-to-string
+ (plist-get plist :thing))
+ 'face (plist-get plist :face))
+ doc))))))
+ (or (progn (elisp-eldoc-var-docstring callback) str)
+ (progn (elisp-eldoc-funcall callback) str))))
+
+(defalias 'elisp-eldoc-documentation-function 'elisp--documentation-one-liner
+ "Return Elisp documentation for the thing at point as one-line string.
+This is meant as a backward compatibility aide to the \"old\"
+Elisp eldoc behaviour. Consider variable docstrings and function
+signatures only, in this order. If none applies, returns nil.
+Changes to `eldoc-documentation-functions' and
+`eldoc-documentation-strategy' are _not_ reflected here. As such
+it is preferrable to use ElDoc's interfaces directly.")
+
+(make-obsolete 'elisp-eldoc-documentation-function
+ "use ElDoc's interfaces instead." "28.1")
+
+(defun elisp-eldoc-funcall (callback &rest _ignored)
+ "Document function call at point.
+Intended for `eldoc-documentation-functions' (which see)."
+ (let* ((sym-info (elisp--fnsym-in-current-sexp))
+ (fn-sym (car sym-info)))
+ (when fn-sym
+ (funcall callback (apply #'elisp-get-fnsym-args-string sym-info)
+ :thing fn-sym
+ :face (if (functionp fn-sym)
+ 'font-lock-function-name-face
+ 'font-lock-keyword-face)))))
+
+(defun elisp-eldoc-var-docstring (callback &rest _ignored)
+ "Document variable at point.
+Intended for `eldoc-documentation-functions' (which see)."
+ (let* ((sym (elisp--current-symbol))
+ (docstring (and sym (elisp-get-var-docstring sym))))
+ (when docstring
+ (funcall callback docstring
+ :thing sym
+ :face 'font-lock-variable-name-face))))
+
+(defun elisp-get-fnsym-args-string (sym &optional index)
"Return a string containing the parameter list of the function SYM.
If SYM is a subr and no arglist is obtainable from the docstring
or elsewhere, return a 1-line docstring."
@@ -1425,20 +1486,13 @@ or elsewhere, return a 1-line docstring."
;; Stringify, and store before highlighting, downcasing, etc.
(elisp--last-data-store sym (elisp-function-argstring args)
'function))))))
- ;; Highlight, truncate.
+ ;; Highlight
(if argstring
(elisp--highlight-function-argument
- sym argstring index
- (or prefix
- (concat (propertize (symbol-name sym) 'face
- (if (functionp sym)
- 'font-lock-function-name-face
- 'font-lock-keyword-face))
- ": "))))))
-
-(defun elisp--highlight-function-argument (sym args index prefix)
- "Highlight argument INDEX in ARGS list for function SYM.
-In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
+ sym argstring index))))
+
+(defun elisp--highlight-function-argument (sym args index)
+ "Highlight argument INDEX in ARGS list for function SYM."
;; FIXME: This should probably work on the list representation of `args'
;; rather than its string representation.
;; FIXME: This function is much too long, we need to split it up!
@@ -1541,7 +1595,6 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
(when start
(setq doc (copy-sequence args))
(add-text-properties start end (list 'face argument-face) doc))
- (setq doc (eldoc-docstring-format-sym-doc prefix doc))
doc)))
;; Return a string containing a brief (one-line) documentation string for
@@ -1554,9 +1607,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
(t
(let ((doc (documentation-property sym 'variable-documentation t)))
(when doc
- (let ((doc (eldoc-docstring-format-sym-doc
- sym (elisp--docstring-first-line doc)
- 'font-lock-variable-name-face)))
+ (let ((doc (elisp--docstring-first-line doc)))
(elisp--last-data-store sym doc 'variable)))))))
(defun elisp--last-data-store (symbol doc type)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 897f105019e..8879726ad59 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1424,6 +1424,10 @@ hits the start of file."
(goto-func goto-tag-location-function)
tag tag-info pt)
(forward-line 1)
+ ;; Exuberant ctags add a line starting with the DEL character;
+ ;; skip past it.
+ (when (looking-at "\177")
+ (forward-line 1))
(while (not (or (eobp) (looking-at "\f")))
;; We used to use explicit tags when available, but the current goto-func
;; can only handle implicit tags.
@@ -1841,7 +1845,7 @@ Also see the documentation of the `tags-file-name' variable."
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
with the command \\[tags-loop-continue].
-For non-interactive use, superceded by `fileloop-initialize-replace'."
+For non-interactive use, superseded by `fileloop-initialize-replace'."
(declare (advertised-calling-convention (from to &optional delimited) "27.1"))
(interactive (query-replace-read-args "Tags query replace (regexp)" t t))
(fileloop-initialize-replace
@@ -2080,8 +2084,8 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol)
(etags--xref-find-definitions symbol))
-(cl-defmethod xref-backend-apropos ((_backend (eql etags)) symbol)
- (etags--xref-find-definitions symbol t))
+(cl-defmethod xref-backend-apropos ((_backend (eql etags)) pattern)
+ (etags--xref-find-definitions (xref-apropos-regexp pattern) t))
(defun etags--xref-find-definitions (pattern &optional regexp?)
;; This emulates the behavior of `find-tag-in-order' but instead of
@@ -2131,8 +2135,10 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
(let ((buffer (find-file-noselect file)))
(with-current-buffer buffer
(save-excursion
- (etags-goto-tag-location tag-info)
- (point-marker))))))
+ (save-restriction
+ (widen)
+ (etags-goto-tag-location tag-info)
+ (point-marker)))))))
(cl-defmethod xref-location-line ((l xref-etags-location))
(with-slots (tag-info) l
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index 22f1cfd7c89..1fbbc892c03 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -1649,25 +1649,28 @@ Return (TYPE NAME), or nil if not found."
(interactive)
(let ((count 1) (case-fold-search t) matching-beg)
(beginning-of-line)
- (while (and (> count 0)
- (re-search-backward f90-program-block-re nil 'move))
- (beginning-of-line)
- (skip-chars-forward " \t0-9")
- ;; Check if in string in case using non-standard feature where
- ;; continued strings do not need "&" at start of continuations.
- (cond ((f90-in-string))
- ((setq matching-beg (f90-looking-at-program-block-start))
- (setq count (1- count)))
- ((f90-looking-at-program-block-end)
- (setq count (1+ count)))))
- (beginning-of-line)
- (if (zerop count)
- matching-beg
- ;; Note this includes the case of an un-named main program,
- ;; in which case we go to (point-min).
- (if (called-interactively-p 'interactive)
- (message "No beginning found"))
- nil)))
+ ;; Check whether we're already at the start of a subprogram.
+ (or (f90-looking-at-program-block-start)
+ ;; We're not; search backwards.
+ (while (and (> count 0)
+ (re-search-backward f90-program-block-re nil 'move))
+ (beginning-of-line)
+ (skip-chars-forward " \t0-9")
+ ;; Check if in string in case using non-standard feature where
+ ;; continued strings do not need "&" at start of continuations.
+ (cond ((f90-in-string))
+ ((setq matching-beg (f90-looking-at-program-block-start))
+ (setq count (1- count)))
+ ((f90-looking-at-program-block-end)
+ (setq count (1+ count)))))
+ (beginning-of-line)
+ (if (zerop count)
+ matching-beg
+ ;; Note this includes the case of an un-named main program,
+ ;; in which case we go to (point-min).
+ (if (called-interactively-p 'interactive)
+ (message "No beginning found"))
+ nil))))
(defun f90-end-of-subprogram ()
"Move point to the end of the current subprogram.
diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el
index 1e9e25641d5..d1985b4f777 100644
--- a/lisp/progmodes/flymake-cc.el
+++ b/lisp/progmodes/flymake-cc.el
@@ -5,18 +5,20 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: languages, c
-;; This program is free software; you can redistribute it and/or modify
+;; 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.
-;; This program is distributed in the hope that it will be useful,
+;; 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 <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
index 62f6d1aaea2..152dc725c74 100644
--- a/lisp/progmodes/flymake-proc.el
+++ b/lisp/progmodes/flymake-proc.el
@@ -37,7 +37,7 @@
;;; Bugs/todo:
;; - Only uses "Makefile", not "makefile" or "GNUmakefile"
-;; (from http://bugs.debian.org/337339).
+;; (from https://bugs.debian.org/337339).
;;; Code:
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 1ed733b7e37..b286208fff9 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -4,9 +4,12 @@
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
-;; Version: 1.0.8
-;; Package-Requires: ((emacs "26.1"))
+;; Version: 1.0.9
;; Keywords: c languages tools
+;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0"))
+
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -223,10 +226,10 @@ Specifically, start it when the saved buffer is actually displayed."
(defcustom flymake-suppress-zero-counters :warning
"Control appearance of zero-valued diagnostic counters in mode line.
-If set to t, supress all zero counters. If set to a severity
+If set to t, suppress all zero counters. If set to a severity
symbol like `:warning' (the default) suppress zero counters less
severe than that severity, according to `warning-numeric-level'.
-If set to nil, don't supress any zero counters."
+If set to nil, don't suppress any zero counters."
:type 'symbol)
(when (fboundp 'define-fringe-bitmap)
@@ -629,7 +632,7 @@ associated `flymake-category' return DEFAULT."
for (ov-prop . value) in
(append (reverse
(flymake--diag-overlay-properties diagnostic))
- (reverse ; ensure ealier props override later ones
+ (reverse ; ensure earlier props override later ones
(flymake--lookup-type-property type 'flymake-overlay-control))
(alist-get type flymake-diagnostic-types-alist))
do (overlay-put ov ov-prop value))
@@ -999,8 +1002,9 @@ special *Flymake log* buffer." :group 'flymake :lighter
(add-hook 'after-change-functions 'flymake-after-change-function nil t)
(add-hook 'after-save-hook 'flymake-after-save-hook nil t)
(add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
+ (add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t)
- ;; If Flymake happened to be alrady already ON, we must cleanup
+ ;; If Flymake happened to be already already ON, we must cleanup
;; existing diagnostic overlays, lest we forget them by blindly
;; reinitializing `flymake--backend-state' in the next line.
;; See https://github.com/joaotavora/eglot/issues/223.
@@ -1016,6 +1020,7 @@ special *Flymake log* buffer." :group 'flymake :lighter
(remove-hook 'after-save-hook 'flymake-after-save-hook t)
(remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t)
;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t)
+ (remove-hook 'eldoc-documentation-functions 'flymake-eldoc-function t)
(mapc #'delete-overlay (flymake--overlays))
@@ -1083,6 +1088,14 @@ START and STOP and LEN are as in `after-change-functions'."
(flymake-mode)
(flymake-log :warning "Turned on in `flymake-find-file-hook'")))
+(defun flymake-eldoc-function (report-doc &rest _)
+ "Document diagnostics at point.
+Intended for `eldoc-documentation-functions' (which see)."
+ (let ((diags (flymake-diagnostics (point))))
+ (when diags
+ (funcall report-doc
+ (mapconcat #'flymake-diagnostic-text diags "\n")))))
+
(defun flymake-goto-next-error (&optional n filter interactive)
"Go to Nth next Flymake diagnostic that matches FILTER.
Interactively, always move to the next diagnostic. With a prefix
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 811951eaaaf..d84c3795653 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -1,4 +1,4 @@
-;;; fortran.el --- Fortran mode for GNU Emacs
+;;; fortran.el --- Fortran mode for GNU Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1986, 1993-1995, 1997-2020 Free Software Foundation,
;; Inc.
@@ -429,7 +429,7 @@ The only difference is, it returns t in a case when the default returns nil."
fortran-font-lock-keywords-1
;; All type specifiers plus their declared items.
(list
- (list (concat fortran-type-types "[ \t(/]*\\(*\\)?")
+ (list (concat fortran-type-types "[ \t(/]*\\(\\*\\)?")
;; Type specifier.
'(1 font-lock-type-face)
;; Declaration item (or just /.../ block name).
@@ -495,14 +495,15 @@ This is used to fontify fixed-format Fortran comments."
;; `byte-compile', but simple benchmarks indicate that it's probably not
;; worth the trouble (about 0.5% of slow down).
(eval ;I hate `eval', but it's hard to avoid it here.
- '(syntax-propertize-rules
+ `(syntax-propertize-rules
("^[CcDd\\*]" (0 "<"))
;; We mark all chars after line-length as "comment-start", rather than
;; just the first one. This is so that a closing ' that's past the
;; line-length will indeed be ignored (and will result in a string that
;; leaks into subsequent lines).
- ((format "^[^CcDd\\*\t\n].\\{%d\\}\\(.+\\)" (1- line-length))
- (1 "<")))))
+ (,(format "^[^CcDd\\*\t\n].\\{%d\\}\\(.+\\)" (1- line-length))
+ (1 "<")))
+ t))
(defvar fortran-font-lock-keywords fortran-font-lock-keywords-1
"Default expressions to highlight in Fortran mode.")
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index e785acd2840..6e9b6830a01 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -8,7 +8,7 @@
;; This file is part of GNU Emacs.
-;; Homepage: http://www.emacswiki.org/emacs/GDB-MI
+;; Homepage: https://www.emacswiki.org/emacs/GDB-MI
;; 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
@@ -89,9 +89,9 @@
;;; Code:
(require 'gud)
-(require 'json)
-(require 'bindat)
(require 'cl-lib)
+(require 'cl-seq)
+(eval-when-compile (require 'pcase))
(declare-function speedbar-change-initial-expansion-list
"speedbar" (new-default))
@@ -105,13 +105,24 @@
(defvar speedbar-initial-expansion-list-name)
(defvar speedbar-frame)
-(defvar gdb-memory-address "main")
-(defvar gdb-memory-last-address nil
+(defvar-local gdb-memory-address-expression "main"
+ "This expression is passed to gdb.
+Possible value: main, $rsp, x+3.")
+(defvar-local gdb-memory-address nil
+ "Address of memory display.")
+(defvar-local gdb-memory-last-address nil
"Last successfully accessed memory address.")
(defvar gdb-memory-next-page nil
"Address of next memory page for program memory buffer.")
(defvar gdb-memory-prev-page nil
"Address of previous memory page for program memory buffer.")
+(defvar-local gdb--memory-display-warning nil
+ "Display warning on memory header if t.
+
+When error occurs when retrieving memory, gdb-mi displays the
+last successful page. In that case the expression might not
+match the memory displayed. We want to let the user be aware of
+that, so display a warning exclamation mark in the header line.")
(defvar gdb-thread-number nil
"Main current thread.
@@ -154,7 +165,7 @@ May be manually changed by user with `gdb-select-frame'.")
"Associative list of threads provided by \"-thread-info\" MI command.
Keys are thread numbers (in strings) and values are structures as
-returned from -thread-info by `gdb-json-partial-output'. Updated in
+returned from -thread-info by `gdb-mi--partial-output'. Updated in
`gdb-thread-list-handler-custom'.")
(defvar gdb-running-threads-count nil
@@ -173,7 +184,7 @@ See also `gdb-running-threads-count'.")
"Associative list of breakpoints provided by \"-break-list\" MI command.
Keys are breakpoint numbers (in string) and values are structures
-as returned from \"-break-list\" by `gdb-json-partial-output'
+as returned from \"-break-list\" by `gdb-mi--partial-output'
\(\"body\" field is used). Updated in
`gdb-breakpoints-list-handler-custom'.")
@@ -211,7 +222,9 @@ Only used for files that Emacs can't find.")
(defvar gdb-source-file-list nil
"List of source files for the current executable.")
(defvar gdb-first-done-or-error t)
-(defvar gdb-source-window nil)
+(defvar gdb-source-window-list nil
+ "List of windows used for displaying source files.
+Sorted in most-recently-visited-first order.")
(defvar gdb-inferior-status nil)
(defvar gdb-continuation nil)
(defvar gdb-supports-non-stop nil)
@@ -242,6 +255,27 @@ Possible values are these symbols:
disposition of output generated by commands that
gdb mode sends to gdb on its own behalf.")
+(defvar gdb--window-configuration-before nil
+ "Stores the window configuration before starting GDB.")
+
+(defcustom gdb-restore-window-configuration-after-quit nil
+ "If non-nil, restore window configuration as of before GDB started.
+
+Possible values are:
+ t -- Always restore.
+ nil -- Don't restore.
+ `if-gdb-show-main' -- Restore only if variable `gdb-show-main'
+ is non-nil
+ `if-gdb-many-windows' -- Restore only if variable `gdb-many-windows'
+ is non-nil."
+ :type '(choice
+ (const :tag "Always restore" t)
+ (const :tag "Don't restore" nil)
+ (const :tag "Depends on `gdb-show-main'" 'if-gdb-show-main)
+ (const :tag "Depends on `gdb-many-windows'" 'if-gdb-many-windows))
+ :group 'gdb
+ :version "28.1")
+
(defcustom gdb-discard-unordered-replies t
"Non-nil means discard any out-of-order GDB replies.
This protects against lost GDB replies, assuming that GDB always
@@ -480,8 +514,6 @@ contains fields of corresponding MI *stopped async record:
Note that \"reason\" is only present in non-stop debugging mode.
-`bindat-get-field' may be used to access the fields of response.
-
Each function is called after the new current thread was selected
and GDB buffers were updated in `gdb-stopped'."
:type '(repeat function)
@@ -592,6 +624,41 @@ Also display the main routine in the disassembly buffer if present."
:group 'gdb
:version "22.1")
+(defcustom gdb-window-configuration-directory user-emacs-directory
+ "Directory where GDB window configuration files are stored.
+If nil, use `default-directory'."
+ :type 'string
+ :group 'gdb
+ :version "28.1")
+
+(defcustom gdb-default-window-configuration-file nil
+ "If non-nil, load this window configuration (layout) on startup.
+This should be the full name of the window configuration file.
+If this is not an absolute path, GDB treats it as a relative path
+and looks under `gdb-window-configuration-directory'.
+
+Note that this variable only takes effect when variable
+`gdb-many-windows' is t."
+ :type '(choice (const :tag "None" nil)
+ string)
+ :group 'gdb
+ :version "28.1")
+
+(defcustom gdb-display-source-buffer-action '(nil . ((inhibit-same-window . t)))
+ "`display-buffer' action used when GDB displays a source buffer."
+ :type 'sexp
+ :group 'gdb
+ :version "28.1")
+
+(defcustom gdb-max-source-window-count 1
+ "Maximum number of source windows to use.
+Until there are such number of source windows on screen, GDB
+tries to open a new window when visiting a new source file; after
+that GDB starts to reuse existing source windows."
+ :type 'number
+ :group 'gdb
+ :version "28.1")
+
(defvar gdbmi-debug-mode nil
"When non-nil, print the messages sent/received from GDB/MI in *Messages*.")
@@ -669,8 +736,10 @@ NOARG must be t when this macro is used outside `gud-def'."
(unless (zerop (length string))
(remove-function (process-filter proc) #'gdb--check-interpreter)
(unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=))
- ;; Apparently we're not running with -i=mi.
- (let ((msg "Error: you did not specify -i=mi on GDB's command line!"))
+ ;; Apparently we're not running with -i=mi (or we're, for
+ ;; instance, debugging something inside a Docker instance with
+ ;; Emacs on the outside).
+ (let ((msg "Error: Either -i=mi wasn't specified on the GDB command line, or the extra socket couldn't be established. Consider using `M-x gud-gdb' instead."))
(message msg)
(setq string (concat (propertize msg 'font-lock-face 'error)
"\n" string)))
@@ -750,6 +819,12 @@ detailed description of this mode.
(gdb-restore-windows)
(error
"Multiple debugging requires restarting in text command mode"))
+
+ ;; Save window configuration before starting gdb so we can restore
+ ;; it after gdb quits. Save it regardless of the value of
+ ;; `gdb-restore-window-configuration-after-quit'.
+ (setq gdb--window-configuration-before (window-state-get))
+
;;
(gud-common-init command-line nil 'gud-gdbmi-marker-filter)
@@ -925,7 +1000,7 @@ detailed description of this mode.
gdb-first-done-or-error t
gdb-buffer-fringe-width (car (window-fringes))
gdb-debug-log nil
- gdb-source-window nil
+ gdb-source-window-list nil
gdb-inferior-status nil
gdb-continuation nil
gdb-buf-publisher '()
@@ -1035,7 +1110,10 @@ no input, and GDB is waiting for input."
(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
-(defconst gdb--string-regexp "\"\\(?:[^\\\"]\\|\\\\.\\)*\"")
+(defconst gdb--string-regexp (rx "\""
+ (* (or (seq "\\" nonl)
+ (not (any "\"\\"))))
+ "\""))
(defun gdb-tooltip-print (expr)
(with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
@@ -1045,11 +1123,11 @@ no input, and GDB is waiting for input."
"\\)")
nil t)
(tooltip-show
- (concat expr " = " (read (match-string 1)))
+ (concat expr " = " (gdb-mi--c-string-from-string (match-string 1)))
(or gud-tooltip-echo-area
(not (display-graphic-p)))))
((re-search-forward "msg=\\(\".+\"\\)$" nil t)
- (tooltip-show (read (match-string 1))
+ (tooltip-show (gdb-mi--c-string-from-string (match-string 1))
(or gud-tooltip-echo-area
(not (display-graphic-p))))))))
@@ -1062,7 +1140,7 @@ no input, and GDB is waiting for input."
(if (search-forward "expands to: " nil t)
(unless (looking-at "\\S-+.*(.*).*")
(gdb-input (concat "-data-evaluate-expression \"" expr "\"")
- `(lambda () (gdb-tooltip-print ,expr)))))))
+ (lambda () (gdb-tooltip-print expr)))))))
(defun gdb-init-buffer ()
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
@@ -1182,23 +1260,26 @@ With arg, enter name of variable to be watched in the minibuffer."
(tooltip-identifier-from-point (point)))))))
(set-text-properties 0 (length expr) nil expr)
(gdb-input (concat "-var-create - * " expr "")
- `(lambda () (gdb-var-create-handler ,expr))))))
+ (lambda () (gdb-var-create-handler expr))))))
(message "gud-watch is a no-op in this mode."))))
+(defsubst gdb-mi--field (value field)
+ (cdr (assq field value)))
+
(defun gdb-var-create-handler (expr)
- (let* ((result (gdb-json-partial-output)))
- (if (not (bindat-get-field result 'msg))
+ (let* ((result (gdb-mi--partial-output)))
+ (if (not (gdb-mi--field result 'msg))
(let ((var
- (list (bindat-get-field result 'name)
+ (list (gdb-mi--field result 'name)
(if (and (string-equal gdb-current-language "c")
gdb-use-colon-colon-notation gdb-selected-frame)
(setq expr (concat gdb-selected-frame "::" expr))
expr)
- (bindat-get-field result 'numchild)
- (bindat-get-field result 'type)
- (bindat-get-field result 'value)
+ (gdb-mi--field result 'numchild)
+ (gdb-mi--field result 'type)
+ (gdb-mi--field result 'value)
nil
- (bindat-get-field result 'has_more)
+ (gdb-mi--field result 'has_more)
gdb-frame-address)))
(push var gdb-var-list)
(speedbar 1)
@@ -1219,41 +1300,31 @@ With arg, enter name of variable to be watched in the minibuffer."
(raise-frame speedbar-frame))
(speedbar-timer-fn))
-(defun gdb-var-evaluate-expression-handler (varnum changed)
- (goto-char (point-min))
- (re-search-forward (concat ".*value=\\(" gdb--string-regexp "\\)")
- nil t)
- (let ((var (assoc varnum gdb-var-list)))
- (when var
- (if changed (setcar (nthcdr 5 var) 'changed))
- (setcar (nthcdr 4 var) (read (match-string 1)))))
- (gdb-speedbar-update))
-
; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
(defun gdb-var-list-children (varnum)
(gdb-input (concat "-var-update " varnum) 'ignore)
(gdb-input (concat "-var-list-children --all-values " varnum)
- `(lambda () (gdb-var-list-children-handler ,varnum))))
+ (lambda () (gdb-var-list-children-handler varnum))))
(defun gdb-var-list-children-handler (varnum)
(let* ((var-list nil)
- (output (bindat-get-field (gdb-json-partial-output "child")))
- (children (bindat-get-field output 'children)))
+ (output (gdb-mi--partial-output 'child))
+ (children (gdb-mi--field output 'children)))
(catch 'child-already-watched
(dolist (var gdb-var-list)
(if (string-equal varnum (car var))
(progn
;; With dynamic varobjs numchild may have increased.
- (setcar (nthcdr 2 var) (bindat-get-field output 'numchild))
+ (setcar (nthcdr 2 var) (gdb-mi--field output 'numchild))
(push var var-list)
(dolist (child children)
- (let ((varchild (list (bindat-get-field child 'name)
- (bindat-get-field child 'exp)
- (bindat-get-field child 'numchild)
- (bindat-get-field child 'type)
- (bindat-get-field child 'value)
+ (let ((varchild (list (gdb-mi--field child 'name)
+ (gdb-mi--field child 'exp)
+ (gdb-mi--field child 'numchild)
+ (gdb-mi--field child 'type)
+ (gdb-mi--field child 'value)
nil
- (bindat-get-field child 'has_more))))
+ (gdb-mi--field child 'has_more))))
(if (assoc (car varchild) gdb-var-list)
(throw 'child-already-watched nil))
(push varchild var-list))))
@@ -1296,7 +1367,7 @@ With arg, enter name of variable to be watched in the minibuffer."
(varnum (car var))
(value (read-string "New value: ")))
(gdb-input (concat "-var-assign " varnum " " value)
- `(lambda () (gdb-edit-value-handler ,value)))))
+ (lambda () (gdb-edit-value-handler value)))))
(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)")
@@ -1312,17 +1383,17 @@ With arg, enter name of variable to be watched in the minibuffer."
'gdb-var-update))
(defun gdb-var-update-handler ()
- (let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist)))
+ (let ((changelist (gdb-mi--field (gdb-mi--partial-output) 'changelist)))
(dolist (var gdb-var-list)
(setcar (nthcdr 5 var) nil))
(let ((temp-var-list gdb-var-list))
(dolist (change changelist)
- (let* ((varnum (bindat-get-field change 'name))
+ (let* ((varnum (gdb-mi--field change 'name))
(var (assoc varnum gdb-var-list))
- (new-num (bindat-get-field change 'new_num_children)))
+ (new-num (gdb-mi--field change 'new_num_children)))
(when var
- (let ((scope (bindat-get-field change 'in_scope))
- (has-more (bindat-get-field change 'has_more)))
+ (let ((scope (gdb-mi--field change 'in_scope))
+ (has-more (gdb-mi--field change 'has_more)))
(cond ((string-equal scope "false")
(if gdb-delete-out-of-scope
(gdb-var-delete-1 var varnum)
@@ -1334,12 +1405,12 @@ With arg, enter name of variable to be watched in the minibuffer."
(not new-num)
(string-equal (nth 2 var) "0"))
(setcar (nthcdr 4 var)
- (bindat-get-field change 'value))
+ (gdb-mi--field change 'value))
(setcar (nthcdr 5 var) 'changed)))
((string-equal scope "invalid")
(gdb-var-delete-1 var varnum)))))
(let ((var-list nil) var1
- (children (bindat-get-field change 'new_children)))
+ (children (gdb-mi--field change 'new_children)))
(when new-num
(setq var1 (pop temp-var-list))
(while var1
@@ -1355,13 +1426,13 @@ With arg, enter name of variable to be watched in the minibuffer."
(push (pop temp-var-list) var-list))
(dolist (child children)
(let ((varchild
- (list (bindat-get-field child 'name)
- (bindat-get-field child 'exp)
- (bindat-get-field child 'numchild)
- (bindat-get-field child 'type)
- (bindat-get-field child 'value)
+ (list (gdb-mi--field child 'name)
+ (gdb-mi--field child 'exp)
+ (gdb-mi--field child 'numchild)
+ (gdb-mi--field child 'type)
+ (gdb-mi--field child 'value)
'changed
- (bindat-get-field child 'has_more))))
+ (gdb-mi--field child 'has_more))))
(push varchild var-list))))
;; Remove deleted children from list.
((< new previous)
@@ -1442,7 +1513,7 @@ thread."
(defun gdb-current-buffer-frame ()
"Get current stack frame object for thread of current buffer."
- (bindat-get-field (gdb-current-buffer-thread) 'frame))
+ (gdb-mi--field (gdb-current-buffer-thread) 'frame))
(defun gdb-buffer-type (buffer)
"Get value of `gdb-buffer-type' for BUFFER."
@@ -1504,9 +1575,9 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
(defun gdb-bind-function-to-buffer (expr buffer)
"Return a function which will evaluate EXPR in BUFFER."
- `(lambda (&rest args)
- (with-current-buffer ,buffer
- (apply ',expr args))))
+ (lambda (&rest args)
+ (with-current-buffer buffer
+ (apply expr args))))
;; Used to display windows with thread-bound buffers
(defmacro def-gdb-preempt-display-buffer (name buffer &optional doc
@@ -1667,25 +1738,25 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
"Interrupt the program being debugged."
(interactive)
(interrupt-process
- (get-buffer-process gud-comint-buffer) comint-ptyp))
+ (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
(defun gdb-io-quit ()
"Send quit signal to the program being debugged."
(interactive)
(quit-process
- (get-buffer-process gud-comint-buffer) comint-ptyp))
+ (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
(defun gdb-io-stop ()
"Stop the program being debugged."
(interactive)
(stop-process
- (get-buffer-process gud-comint-buffer) comint-ptyp))
+ (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io)) comint-ptyp))
(defun gdb-io-eof ()
"Send end-of-file to the program being debugged."
(interactive)
(process-send-eof
- (get-buffer-process gud-comint-buffer)))
+ (get-buffer-process (gdb-get-buffer-create 'gdb-inferior-io))))
(defun gdb-clear-inferior-io ()
(with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
@@ -1788,7 +1859,8 @@ static char *magick[] = {
"\\|def\\(i\\(ne?\\)?\\)?\\|doc\\(u\\(m\\(e\\(nt?\\)?\\)?\\)?\\)?\\|"
gdb-python-guile-commands-regexp
"\\|while-stepping\\|stepp\\(i\\(ng?\\)?\\)?\\|ws\\|actions"
- "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)?$")
+ "\\|expl\\(o\\(re?\\)?\\)?"
+ "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)*$")
"Regexp matching GDB commands that enter a recursive reading loop.
As long as GDB is in the recursive reading loop, it does not expect
commands to be prefixed by \"-interpreter-exec console\".")
@@ -1976,7 +2048,7 @@ For all-stop mode, thread information is unavailable while target
is running."
(let ((old-value gud-running))
(setq gud-running
- (string= (bindat-get-field (gdb-current-buffer-thread) 'state)
+ (string= (gdb-mi--field (gdb-current-buffer-thread) 'state)
"running"))
;; Set frame number to "0" when _current_ threads stops.
(when (and (gdb-current-buffer-thread)
@@ -2007,17 +2079,36 @@ is running."
;; GDB frame (after up, down etc). If no GDB frame is visible but the last
;; visited breakpoint is, use that window.
(defun gdb-display-source-buffer (buffer)
- (let* ((last-window (if gud-last-last-frame
- (get-buffer-window
- (gud-find-file (car gud-last-last-frame)))))
- (source-window (or last-window
- (if (and gdb-source-window
- (window-live-p gdb-source-window))
- gdb-source-window))))
- (when source-window
- (setq gdb-source-window source-window)
- (set-window-buffer source-window buffer))
- source-window))
+ "Find a window to display BUFFER.
+Always find a window to display buffer, and return it."
+ ;; This function doesn't take care of setting up source window(s) at startup,
+ ;; that's handled by `gdb-setup-windows' (if `gdb-many-windows' is non-nil).
+ ;; If `buffer' is already shown in a window, use that window.
+ (or (get-buffer-window buffer)
+ (progn
+ ;; First, update the window list.
+ (setq gdb-source-window-list
+ (cl-remove-duplicates
+ (cl-remove-if-not
+ (lambda (win)
+ (and (window-live-p win)
+ (eq (window-frame win)
+ (selected-frame))))
+ gdb-source-window-list)))
+ ;; Should we create a new window or reuse one?
+ (if (> gdb-max-source-window-count
+ (length gdb-source-window-list))
+ ;; Create a new window, push it to window list and return it.
+ (car (push (display-buffer buffer gdb-display-source-buffer-action)
+ gdb-source-window-list))
+ ;; Reuse a window, we use the oldest window and put that to
+ ;; the front of the window list.
+ (let ((last-win (car (last gdb-source-window-list)))
+ (rest (butlast gdb-source-window-list)))
+ (set-window-buffer last-win buffer)
+ (setq gdb-source-window-list
+ (cons last-win rest))
+ last-win)))))
(defun gdbmi-start-with (str offset match)
@@ -2214,7 +2305,8 @@ a GDB/MI reply message."
;; Suppress "No registers." GDB 6.8 and earlier
;; duplicates MI error message on internal stream.
;; Don't print to GUD buffer.
- (if (not (string-equal (read c-string) "No registers.\n"))
+ (if (not (string-equal (gdb-mi--c-string-from-string c-string)
+ "No registers.\n"))
(gdb-internals c-string)))
@@ -2336,7 +2428,7 @@ the end of the current result or async record is reached."
is-complete)))
-; The following grammar rules are not yet implemented by this GDBMI-BNF parser.
+; The following grammar rules are not parsed directly by this GDBMI-BNF parser.
; The handling of those rules is currently done by the handlers registered
; in gdbmi-bnf-result-state-configs
;
@@ -2358,19 +2450,17 @@ the end of the current result or async record is reached."
; list ==>
; "[]" | "[" value ( "," value )* "]" | "[" result ( "," result )* "]"
-(defcustom gdb-mi-decode-strings nil
+;; FIXME: This is fragile: it relies on the assumption that all the
+;; non-ASCII strings output by GDB, including names of the source
+;; files, values of string variables in the inferior, etc., are all
+;; encoded in the same encoding.
+
+(defcustom gdb-mi-decode-strings t
"When non-nil, decode octal escapes in GDB output into non-ASCII text.
If the value is a coding-system, use that coding-system to decode
the bytes reconstructed from octal escapes. Any other non-nil value
-means to decode using the coding-system set for the GDB process.
-
-Warning: setting this non-nil might mangle strings reported by GDB
-that have literal substrings which match the \\nnn octal escape
-patterns, where nnn is an octal number between 200 and 377. So
-we only recommend to set this variable non-nil if the program you
-are debugging really reports non-ASCII text, or some of its source
-file names include non-ASCII characters."
+means to decode using the coding-system set for the GDB process."
:type '(choice
(const :tag "Don't decode" nil)
(const :tag "Decode using default coding-system" t)
@@ -2378,47 +2468,9 @@ file names include non-ASCII characters."
:group 'gdb
:version "25.1")
-;; The idea of the following function was suggested
-;; by Kenichi Handa <handa@gnu.org>.
-;;
-;; FIXME: This is fragile: it relies on the assumption that all the
-;; non-ASCII strings output by GDB, including names of the source
-;; files, values of string variables in the inferior, etc., are all
-;; encoded in the same encoding. It also assumes that the \nnn
-;; sequences are not split between chunks of output of the GDB process
-;; due to buffering, and arrive together. Finally, if some string
-;; included literal \nnn strings (as opposed to non-ASCII characters
-;; converted by GDB/MI to octal escapes), this decoding will mangle
-;; those strings. When/if GDB acquires the ability to not
-;; escape-protect non-ASCII characters in its MI output, this kludge
-;; should be removed.
-(defun gdb-mi-decode (string)
- "Decode octal escapes in MI output STRING into multibyte text."
- (let ((coding
- (if (coding-system-p gdb-mi-decode-strings)
- gdb-mi-decode-strings
- (with-current-buffer
- (gdb-get-buffer-create 'gdb-partial-output-buffer)
- buffer-file-coding-system))))
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (prin1 string (current-buffer))
- (goto-char (point-min))
- ;; prin1 quotes the octal escapes as well, which interferes with
- ;; their interpretation by 'read' below. Remove the extra
- ;; backslashes to countermand that.
- (while (re-search-forward "\\\\\\(\\\\[2-3][0-7][0-7]\\)" nil t)
- (replace-match "\\1" nil nil))
- (goto-char (point-min))
- (decode-coding-string (read (current-buffer)) coding))))
-
(defun gud-gdbmi-marker-filter (string)
"Filter GDB/MI output."
- ;; If required, decode non-ASCII text encoded with octal escapes.
- (or (null gdb-mi-decode-strings)
- (setq string (gdb-mi-decode string)))
-
;; Record transactions if logging is enabled.
(when gdb-enable-debug
(push (cons 'recv string) gdb-debug-log)
@@ -2446,7 +2498,13 @@ file names include non-ASCII characters."
gdb-filter-output)
-(defun gdb-gdb (_output-field))
+(defun gdb-gdb (_output-field)
+ ;; This is needed because the "explore" command is not ended by the
+ ;; likes of "end" or "quit", but instead by a RET at the appropriate
+ ;; place, and we know we have exited "explore" when we get the
+ ;; "(gdb)" prompt.
+ (and (> gdb-control-level 0)
+ (setq gdb-control-level (1- gdb-control-level))))
(defun gdb-shell (output-field)
(setq gdb-filter-output
@@ -2459,7 +2517,7 @@ file names include non-ASCII characters."
(defun gdb-thread-exited (_token output-field)
"Handle =thread-exited async record.
Unset `gdb-thread-number' if current thread exited and update threads list."
- (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id)))
+ (let* ((thread-id (gdb-mi--field (gdb-mi--from-string output-field) 'id)))
(if (string= gdb-thread-number thread-id)
(gdb-setq-thread-number nil))
;; When we continue current thread and it quickly exits,
@@ -2473,8 +2531,8 @@ Unset `gdb-thread-number' if current thread exited and update threads list."
"Handler for =thread-selected MI output record.
Sets `gdb-thread-number' to new id."
- (let* ((result (gdb-json-string output-field))
- (thread-id (bindat-get-field result 'id)))
+ (let* ((result (gdb-mi--from-string output-field))
+ (thread-id (gdb-mi--field result 'id)))
(gdb-setq-thread-number thread-id)
;; Typing `thread N' in GUD buffer makes GDB emit `^done' followed
;; by `=thread-selected' notification. `^done' causes `gdb-update'
@@ -2489,7 +2547,7 @@ Sets `gdb-thread-number' to new id."
(defun gdb-running (_token output-field)
(let* ((thread-id
- (bindat-get-field (gdb-json-string output-field) 'thread-id)))
+ (gdb-mi--field (gdb-mi--from-string output-field) 'thread-id)))
;; We reset gdb-frame-number to nil if current thread has gone
;; running. This can't be done in gdb-thread-list-handler-custom
;; because we need correct gdb-frame-number by the time
@@ -2518,11 +2576,11 @@ Sets `gdb-thread-number' to new id."
"Given the contents of *stopped MI async record, select new
current thread and update GDB buffers."
;; Reason is available with target-async only
- (let* ((result (gdb-json-string output-field))
- (reason (bindat-get-field result 'reason))
- (thread-id (bindat-get-field result 'thread-id))
- (retval (bindat-get-field result 'return-value))
- (varnum (bindat-get-field result 'gdb-result-var)))
+ (let* ((result (gdb-mi--from-string output-field))
+ (reason (gdb-mi--field result 'reason))
+ (thread-id (gdb-mi--field result 'thread-id))
+ (retval (gdb-mi--field result 'return-value))
+ (varnum (gdb-mi--field result 'gdb-result-var)))
;; -data-list-register-names needs to be issued for any stopped
;; thread
@@ -2565,7 +2623,7 @@ current thread and update GDB buffers."
;; gdb-switch-when-another-stopped:
(when (or gdb-switch-when-another-stopped
(not (string= "stopped"
- (bindat-get-field (gdb-current-buffer-thread) 'state))))
+ (gdb-mi--field (gdb-current-buffer-thread) 'state))))
;; Switch if current reason has been selected or we have no
;; reasons
(if (or (eq gdb-switch-reasons t)
@@ -2598,7 +2656,7 @@ current thread and update GDB buffers."
(if (string= output-field "\"\\n\"")
""
(let ((error-message
- (read output-field)))
+ (gdb-mi--c-string-from-string output-field)))
(put-text-property
0 (length error-message)
'face font-lock-warning-face
@@ -2609,7 +2667,8 @@ current thread and update GDB buffers."
;; (frontend MI commands should not print to this stream)
(defun gdb-console (output-field)
(setq gdb-filter-output
- (gdb-concat-output gdb-filter-output (read output-field))))
+ (gdb-concat-output gdb-filter-output
+ (gdb-mi--c-string-from-string output-field))))
(defun gdb-done (token-number output-field is-complete)
(gdb-done-or-error token-number 'done output-field is-complete))
@@ -2626,7 +2685,8 @@ current thread and update GDB buffers."
;; MI error - send to minibuffer
(when (eq type 'error)
;; Skip "msg=" from `output-field'
- (message "%s" (read (substring output-field 4)))
+ (message "%s" (gdb-mi--c-string-from-string
+ (substring output-field 4)))
;; Don't send to the console twice. (If it is a console error
;; it is also in the console stream.)
(setq output-field nil)))
@@ -2674,83 +2734,154 @@ current thread and update GDB buffers."
(with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
(erase-buffer)))
-(defun gdb-jsonify-buffer (&optional fix-key fix-list)
- "Prepare GDB/MI output in current buffer for parsing with `json-read'.
-
-Field names are wrapped in double quotes and equal signs are
-replaced with semicolons.
-
-If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from
-partial output. This is used to get rid of useless keys in lists
-in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
--break-info are examples of MI commands which issue such
-responses.
-
-If FIX-LIST is non-nil, \"FIX-LIST={..}\" is replaced with
-\"FIX-LIST=[..]\" prior to parsing. This is used to fix broken
--break-info output when it contains breakpoint script field
-incompatible with GDB/MI output syntax.
+;; Parse GDB/MI result records: this process converts
+;; list [...] -> list
+;; tuple {...} -> list
+;; result KEY=VALUE -> (KEY . VALUE) where KEY is a symbol
+;; c-string "..." -> string
+
+(defun gdb-mi--parse-tuple-or-list (end-char)
+ "Parse a tuple or list, either returned as a Lisp list.
+END-CHAR is the ending delimiter; will stop at end-of-buffer otherwise."
+ (let ((items nil))
+ (while (not (or (eobp)
+ (eq (following-char) end-char)))
+ (let ((item (gdb-mi--parse-result-or-value)))
+ (push item items)
+ (when (eq (following-char) ?,)
+ (forward-char))))
+ (when (eq (following-char) end-char)
+ (forward-char))
+ (nreverse items)))
+
+(defun gdb-mi--parse-c-string ()
+ "Parse a c-string."
+ (let ((start (point))
+ (pieces nil)
+ (octals-used nil))
+ (while (and (re-search-forward (rx (or ?\\ ?\")))
+ (not (eq (preceding-char) ?\")))
+ (push (buffer-substring start (1- (point))) pieces)
+ (cond
+ ((looking-at (rx (any "0-7") (? (any "0-7") (? (any "0-7")))))
+ (push (unibyte-string (string-to-number (match-string 0) 8)) pieces)
+ (setq octals-used t)
+ (goto-char (match-end 0)))
+ ((looking-at (rx (any "ntrvfab\"\\")))
+ (push (cdr (assq (following-char)
+ '((?n . "\n")
+ (?t . "\t")
+ (?r . "\r")
+ (?v . "\v")
+ (?f . "\f")
+ (?a . "\a")
+ (?b . "\b")
+ (?\" . "\"")
+ (?\\ . "\\"))))
+ pieces)
+ (forward-char))
+ (t
+ (warn "Unrecognised escape char: %c" (following-char))))
+ (setq start (point)))
+ (push (buffer-substring start (1- (point))) pieces)
+ (let ((s (apply #'concat (nreverse pieces))))
+ (if (and octals-used gdb-mi-decode-strings)
+ (let ((coding
+ (if (coding-system-p gdb-mi-decode-strings)
+ gdb-mi-decode-strings
+ (buffer-local-value
+ 'buffer-file-coding-system
+ ;; FIXME: This is somewhat expensive.
+ (gdb-get-buffer-create 'gdb-partial-output-buffer)))))
+ (decode-coding-string s coding))
+ s))))
+
+;; FIXME: Ideally this function should not be needed.
+(defun gdb-mi--c-string-from-string (string)
+ "Parse a c-string from (the beginning of) STRING."
+ (with-temp-buffer
+ (insert string)
+ (goto-char (1+ (point-min))) ; Skip leading double quote.
+ (gdb-mi--parse-c-string)))
-If `default-directory' is remote, full file names are adapted accordingly."
- (save-excursion
+(defun gdb-mi--parse-value ()
+ "Parse a value."
+ (cond
+ ((eq (following-char) ?\{)
+ (forward-char)
+ (gdb-mi--parse-tuple-or-list ?\}))
+ ((eq (following-char) ?\[)
+ (forward-char)
+ (gdb-mi--parse-tuple-or-list ?\]))
+ ((eq (following-char) ?\")
+ (forward-char)
+ (gdb-mi--parse-c-string))
+ (t (error "Bad start of result or value: %c" (following-char)))))
+
+(defun gdb-mi--parse-result-or-value ()
+ "Parse a result (key=value) or value."
+ (if (looking-at (rx (group (+ (any "a-zA-Z" ?_ ?-))) "="))
+ (progn
+ (goto-char (match-end 0))
+ (let* ((variable (intern (match-string 1)))
+ (value (gdb-mi--parse-value)))
+ (cons variable value)))
+ (gdb-mi--parse-value)))
+
+(defun gdb-mi--parse-results ()
+ "Parse zero or more result productions as a list."
+ (gdb-mi--parse-tuple-or-list nil))
+
+(defun gdb-mi--fix-key (key value)
+ "Convert any result (key-value pair) in VALUE whose key is KEY to its value."
+ (cond
+ ((atom value) value)
+ ((symbolp (car value))
+ (if (eq (car value) key)
+ (cdr value)
+ (cons (car value) (gdb-mi--fix-key key (cdr value)))))
+ (t (mapcar (lambda (x) (gdb-mi--fix-key key x)) value))))
+
+(defun gdb-mi--extend-fullname (remote value)
+ "Prepend REMOTE to any result string with `fullname' as the key in VALUE."
+ (cond
+ ((atom value) value)
+ ((symbolp (car value))
+ (if (and (eq (car value) 'fullname)
+ (stringp (cdr value)))
+ (cons 'fullname (concat remote (cdr value)))
+ (cons (car value) (gdb-mi--extend-fullname remote (cdr value)))))
+ (t (mapcar (lambda (x) (gdb-mi--extend-fullname remote x)) value))))
+
+(defun gdb-mi--read-buffer (fix-key)
+ "Parse the current buffer as a list of result productions.
+If FIX-KEY is a non-nil symbol, convert all FIX-KEY=VALUE results into VALUE.
+This is used to get rid of useless keys in lists in MI messages;
+eg, [key=.., key=..]. -stack-list-frames and -break-info are
+examples of MI commands which issue such responses."
+ (goto-char (point-min))
+ (let ((results (gdb-mi--parse-results)))
(let ((remote (file-remote-p default-directory)))
(when remote
- (goto-char (point-min))
- (while (re-search-forward "[\\[,]fullname=\"\\(.+\\)\"" nil t)
- (replace-match (concat remote "\\1") nil nil nil 1))))
- (goto-char (point-min))
+ (setq results (gdb-mi--extend-fullname remote results))))
(when fix-key
- (save-excursion
- (while (re-search-forward (concat "[\\[,]\\(" fix-key "=\\)") nil t)
- (replace-match "" nil nil nil 1))))
- (when fix-list
- (save-excursion
- ;; Find positions of braces which enclose broken list
- (while (re-search-forward (concat fix-list "={\"") nil t)
- (let ((p1 (goto-char (- (point) 2)))
- (p2 (progn (forward-sexp)
- (1- (point)))))
- ;; Replace braces with brackets
- (save-excursion
- (goto-char p1)
- (delete-char 1)
- (insert "[")
- (goto-char p2)
- (delete-char 1)
- (insert "]"))))))
- (goto-char (point-min))
- (insert "{")
- (let ((re (concat "\\([[:alnum:]_-]+\\)=")))
- (while (re-search-forward re nil t)
- (replace-match "\"\\1\":" nil nil)
- (if (eq (char-after) ?\") (forward-sexp) (forward-char))))
- (goto-char (point-max))
- (insert "}")))
+ (setq results (gdb-mi--fix-key fix-key results)))
+ results))
-(defun gdb-json-read-buffer (&optional fix-key fix-list)
- "Prepare and parse GDB/MI output in current buffer with `json-read'.
+(defun gdb-mi--from-string (string &optional fix-key)
+ "Prepare and parse STRING containing GDB/MI output.
-FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'."
- (gdb-jsonify-buffer fix-key fix-list)
- (save-excursion
- (goto-char (point-min))
- (let ((json-array-type 'list))
- (json-read))))
-
-(defun gdb-json-string (string &optional fix-key fix-list)
- "Prepare and parse STRING containing GDB/MI output with `json-read'.
-
-FIX-KEY and FIX-LIST work as in `gdb-jsonify-buffer'."
+FIX-KEY works as in `gdb-mi--read-buffer'."
(with-temp-buffer
(insert string)
- (gdb-json-read-buffer fix-key fix-list)))
+ (gdb-mi--read-buffer fix-key)))
-(defun gdb-json-partial-output (&optional fix-key fix-list)
- "Prepare and parse gdb-partial-output-buffer with `json-read'.
+(defun gdb-mi--partial-output (&optional fix-key)
+ "Prepare and parse gdb-partial-output-buffer.
-FIX-KEY and FIX-KEY work as in `gdb-jsonify-buffer'."
+FIX-KEY works as in `gdb-mi--read-buffer'."
(with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
- (gdb-json-read-buffer fix-key fix-list)))
+ (gdb-mi--read-buffer fix-key)))
(defun gdb-line-posns (line)
"Return a pair of LINE beginning and end positions."
@@ -2831,14 +2962,6 @@ calling `gdb-table-string'."
(gdb-table-row-properties table))
"\n")))
-;; bindat-get-field goes deep, gdb-get-many-fields goes wide
-(defun gdb-get-many-fields (struct &rest fields)
- "Return a list of FIELDS values from STRUCT."
- (let ((values))
- (dolist (field fields)
- (push (bindat-get-field struct field) values))
- (nreverse values)))
-
(defmacro def-gdb-auto-update-trigger (trigger-name gdb-command
handler-name
&optional signal-list)
@@ -2926,26 +3049,27 @@ See `def-gdb-auto-update-handler'."
'gdb-invalidate-breakpoints)
(defun gdb-breakpoints-list-handler-custom ()
- (let ((breakpoints-list (bindat-get-field
- (gdb-json-partial-output "bkpt" "script")
- 'BreakpointTable 'body))
+ (let ((breakpoints-list (gdb-mi--field
+ (gdb-mi--field (gdb-mi--partial-output 'bkpt)
+ 'BreakpointTable)
+ 'body))
(table (make-gdb-table)))
(setq gdb-breakpoints-list nil)
(gdb-table-add-row table '("Num" "Type" "Disp" "Enb" "Addr" "Hits" "What"))
(dolist (breakpoint breakpoints-list)
(add-to-list 'gdb-breakpoints-list
- (cons (bindat-get-field breakpoint 'number)
+ (cons (gdb-mi--field breakpoint 'number)
breakpoint))
- (let ((at (bindat-get-field breakpoint 'at))
- (pending (bindat-get-field breakpoint 'pending))
- (func (bindat-get-field breakpoint 'func))
- (type (bindat-get-field breakpoint 'type)))
+ (let ((at (gdb-mi--field breakpoint 'at))
+ (pending (gdb-mi--field breakpoint 'pending))
+ (func (gdb-mi--field breakpoint 'func))
+ (type (gdb-mi--field breakpoint 'type)))
(gdb-table-add-row table
(list
- (bindat-get-field breakpoint 'number)
+ (gdb-mi--field breakpoint 'number)
(or type "")
- (or (bindat-get-field breakpoint 'disp) "")
- (let ((flag (bindat-get-field breakpoint 'enabled)))
+ (or (gdb-mi--field breakpoint 'disp) "")
+ (let ((flag (gdb-mi--field breakpoint 'enabled)))
(if (string-equal flag "y")
(eval-when-compile
(propertize "y" 'font-lock-face
@@ -2953,10 +3077,10 @@ See `def-gdb-auto-update-handler'."
(eval-when-compile
(propertize "n" 'font-lock-face
font-lock-comment-face))))
- (bindat-get-field breakpoint 'addr)
- (or (bindat-get-field breakpoint 'times) "")
+ (gdb-mi--field breakpoint 'addr)
+ (or (gdb-mi--field breakpoint 'times) "")
(if (and type (string-match ".*watchpoint" type))
- (bindat-get-field breakpoint 'what)
+ (gdb-mi--field breakpoint 'what)
(or pending at
(concat "in "
(propertize (or func "unknown")
@@ -2981,11 +3105,11 @@ See `def-gdb-auto-update-handler'."
(dolist (breakpoint gdb-breakpoints-list)
(let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is
; an associative list
- (line (bindat-get-field breakpoint 'line)))
+ (line (gdb-mi--field breakpoint 'line)))
(when line
- (let ((file (bindat-get-field breakpoint 'fullname))
- (flag (bindat-get-field breakpoint 'enabled))
- (bptno (bindat-get-field breakpoint 'number)))
+ (let ((file (gdb-mi--field breakpoint 'fullname))
+ (flag (gdb-mi--field breakpoint 'enabled))
+ (bptno (gdb-mi--field breakpoint 'number)))
(unless (and file (file-exists-p file))
(setq file (cdr (assoc bptno gdb-location-alist))))
(if (or (null file)
@@ -2993,11 +3117,11 @@ See `def-gdb-auto-update-handler'."
;; If the full filename is not recorded in the
;; breakpoint structure or in `gdb-location-alist', use
;; -file-list-exec-source-file to extract it.
- (when (setq file (bindat-get-field breakpoint 'file))
+ (when (setq file (gdb-mi--field breakpoint 'file))
(gdb-input (concat "list " file ":1") 'ignore)
(gdb-input "-file-list-exec-source-file"
- `(lambda () (gdb-get-location
- ,bptno ,line ,flag))))
+ (lambda () (gdb-get-location
+ bptno line flag))))
(with-current-buffer (find-file-noselect file 'nowarn)
(gdb-init-buffer)
;; Only want one breakpoint icon at each location.
@@ -3249,7 +3373,7 @@ corresponding to the mode line clicked."
'gdb-invalidate-threads)
(defun gdb-thread-list-handler-custom ()
- (let ((threads-list (bindat-get-field (gdb-json-partial-output) 'threads))
+ (let ((threads-list (gdb-mi--field (gdb-mi--partial-output) 'threads))
(table (make-gdb-table))
(marked-line nil))
(setq gdb-threads-list nil)
@@ -3258,9 +3382,9 @@ corresponding to the mode line clicked."
(set-marker gdb-thread-position nil)
(dolist (thread (reverse threads-list))
- (let ((running (equal (bindat-get-field thread 'state) "running")))
+ (let ((running (equal (gdb-mi--field thread 'state) "running")))
(add-to-list 'gdb-threads-list
- (cons (bindat-get-field thread 'id)
+ (cons (gdb-mi--field thread 'id)
thread))
(cl-incf (if running
gdb-running-threads-count
@@ -3269,37 +3393,41 @@ corresponding to the mode line clicked."
(gdb-table-add-row
table
(list
- (bindat-get-field thread 'id)
+ (gdb-mi--field thread 'id)
(concat
(if gdb-thread-buffer-verbose-names
- (concat (bindat-get-field thread 'target-id) " ") "")
- (bindat-get-field thread 'state)
+ (concat (gdb-mi--field thread 'target-id) " ") "")
+ (gdb-mi--field thread 'state)
;; Include frame information for stopped threads
(if (not running)
(concat
- " in " (bindat-get-field thread 'frame 'func)
+ " in " (gdb-mi--field (gdb-mi--field thread 'frame) 'func)
(if gdb-thread-buffer-arguments
(concat
" ("
- (let ((args (bindat-get-field thread 'frame 'args)))
+ (let ((args (gdb-mi--field (gdb-mi--field thread 'frame)
+ 'args)))
(mapconcat
(lambda (arg)
- (apply #'format "%s=%s"
- (gdb-get-many-fields arg 'name 'value)))
+ (format "%s=%s"
+ (gdb-mi--field arg 'name)
+ (gdb-mi--field arg 'value)))
args ","))
")")
"")
(if gdb-thread-buffer-locations
- (gdb-frame-location (bindat-get-field thread 'frame)) "")
+ (gdb-frame-location (gdb-mi--field thread 'frame)) "")
(if gdb-thread-buffer-addresses
- (concat " at " (bindat-get-field thread 'frame 'addr)) ""))
+ (concat " at " (gdb-mi--field (gdb-mi--field thread 'frame)
+ 'addr))
+ ""))
"")))
(list
'gdb-thread thread
'mouse-face 'highlight
'help-echo "mouse-2, RET: select thread")))
(when (string-equal gdb-thread-number
- (bindat-get-field thread 'id))
+ (gdb-mi--field thread 'id))
(setq marked-line (length gdb-threads-list))))
(insert (gdb-table-string table " "))
(when marked-line
@@ -3331,11 +3459,11 @@ If `gdb-thread' is nil, error is signaled."
"Define a NAME which will call BUFFER-COMMAND with id of thread
on the current line."
`(def-gdb-thread-buffer-command ,name
- (,buffer-command (bindat-get-field thread 'id))
+ (,buffer-command (gdb-mi--field thread 'id))
,doc))
(def-gdb-thread-buffer-command gdb-select-thread
- (let ((new-id (bindat-get-field thread 'id)))
+ (let ((new-id (gdb-mi--field thread 'id)))
(gdb-setq-thread-number new-id)
(gdb-input (concat "-thread-select " new-id) 'ignore)
(gdb-update))
@@ -3387,7 +3515,7 @@ on the current line."
line."
`(def-gdb-thread-buffer-command ,name
(if gdb-non-stop
- (let ((gdb-thread-number (bindat-get-field thread 'id))
+ (let ((gdb-thread-number (gdb-mi--field thread 'id))
(gdb-gud-control-all-threads nil))
(call-interactively #',gud-command))
(error "Available in non-stop mode only, customize `gdb-non-stop-setting'"))
@@ -3450,7 +3578,7 @@ line."
(def-gdb-trigger-and-handler
gdb-invalidate-memory
(format "-data-read-memory %s %s %d %d %d"
- gdb-memory-address
+ (gdb-mi-quote gdb-memory-address-expression)
gdb-memory-format
gdb-memory-unit
gdb-memory-rows
@@ -3486,27 +3614,35 @@ in `gdb-memory-format'."
(error "Unknown format"))))
(defun gdb-read-memory-custom ()
- (let* ((res (gdb-json-partial-output))
- (err-msg (bindat-get-field res 'msg)))
+ (let* ((res (gdb-mi--partial-output))
+ (err-msg (gdb-mi--field res 'msg)))
(if (not err-msg)
- (let ((memory (bindat-get-field res 'memory)))
- (setq gdb-memory-address (bindat-get-field res 'addr))
- (setq gdb-memory-next-page (bindat-get-field res 'next-page))
- (setq gdb-memory-prev-page (bindat-get-field res 'prev-page))
+ (let ((memory (gdb-mi--field res 'memory)))
+ (when gdb-memory-last-address
+ ;; Nil means last retrieve emits error or just started the session.
+ (setq gdb--memory-display-warning nil))
+ (setq gdb-memory-address (gdb-mi--field res 'addr))
+ (setq gdb-memory-next-page (gdb-mi--field res 'next-page))
+ (setq gdb-memory-prev-page (gdb-mi--field res 'prev-page))
(setq gdb-memory-last-address gdb-memory-address)
(dolist (row memory)
- (insert (concat (bindat-get-field row 'addr) ":"))
- (dolist (column (bindat-get-field row 'data))
+ (insert (concat (gdb-mi--field row 'addr) ":"))
+ (dolist (column (gdb-mi--field row 'data))
(insert (gdb-pad-string column
(+ 2 (gdb-memory-column-width
gdb-memory-unit
gdb-memory-format)))))
(newline)))
;; Show last page instead of empty buffer when out of bounds
- (progn
- (let ((gdb-memory-address gdb-memory-last-address))
+ (when gdb-memory-last-address
+ (let ((gdb-memory-address-expression gdb-memory-last-address))
+ ;; If we don't set `gdb-memory-last-address' to nil,
+ ;; `gdb-invalidate-memory' eventually calls
+ ;; `gdb-read-memory-custom', making an infinite loop.
+ (setq gdb-memory-last-address nil
+ gdb--memory-display-warning t)
(gdb-invalidate-memory 'update)
- (error err-msg))))))
+ (user-error "Error when retrieving memory: %s Displaying last successful page" err-msg))))))
(defvar gdb-memory-mode-map
(let ((map (make-sparse-keymap)))
@@ -3540,7 +3676,7 @@ in `gdb-memory-format'."
"Set the start memory address."
(interactive)
(let ((arg (read-from-minibuffer "Memory address: ")))
- (setq gdb-memory-address arg))
+ (setq gdb-memory-address-expression arg))
(gdb-invalidate-memory 'update))
(defmacro def-gdb-set-positive-number (name variable echo-string &optional doc)
@@ -3723,7 +3859,19 @@ DOC is an optional documentation string."
(defvar gdb-memory-header
'(:eval
(concat
- "Start address["
+ "Start address "
+ ;; If `gdb-memory-address-expression' is nil, `propertize' would error.
+ (propertize (or gdb-memory-address-expression "N/A")
+ 'face font-lock-warning-face
+ 'help-echo "mouse-1: set start address"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (gdb-make-header-line-mouse-map
+ 'mouse-1
+ #'gdb-memory-set-address-event))
+ (if gdb--memory-display-warning
+ (propertize " !" 'face '(:inherit error :weight bold))
+ "")
+ " ["
(propertize "-"
'face font-lock-warning-face
'help-echo "mouse-1: decrement address"
@@ -3740,13 +3888,9 @@ DOC is an optional documentation string."
'mouse-1
#'gdb-memory-show-next-page))
"]: "
- (propertize gdb-memory-address
- 'face font-lock-warning-face
- 'help-echo "mouse-1: set start address"
- 'mouse-face 'mode-line-highlight
- 'local-map (gdb-make-header-line-mouse-map
- 'mouse-1
- #'gdb-memory-set-address-event))
+ ;; If `gdb-memory-address' is nil, `propertize' would error.
+ (propertize (or gdb-memory-address "N/A")
+ 'face font-lock-warning-face)
" Rows: "
(propertize (number-to-string gdb-memory-rows)
'face font-lock-warning-face
@@ -3822,8 +3966,8 @@ DOC is an optional documentation string."
(def-gdb-auto-update-trigger gdb-invalidate-disassembly
(let* ((frame (gdb-current-buffer-frame))
- (file (bindat-get-field frame 'fullname))
- (line (bindat-get-field frame 'line)))
+ (file (gdb-mi--field frame 'fullname))
+ (line (gdb-mi--field frame 'line)))
(if file
(format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)
;; If we're unable to get a file name / line for $PC, simply
@@ -3879,22 +4023,22 @@ DOC is an optional documentation string."
'gdb-invalidate-disassembly)
(defun gdb-disassembly-handler-custom ()
- (let* ((instructions (bindat-get-field (gdb-json-partial-output) 'asm_insns))
- (address (bindat-get-field (gdb-current-buffer-frame) 'addr))
+ (let* ((instructions (gdb-mi--field (gdb-mi--partial-output) 'asm_insns))
+ (address (gdb-mi--field (gdb-current-buffer-frame) 'addr))
(table (make-gdb-table))
(marked-line nil))
(dolist (instr instructions)
(gdb-table-add-row table
(list
- (bindat-get-field instr 'address)
+ (gdb-mi--field instr 'address)
(let
- ((func-name (bindat-get-field instr 'func-name))
- (offset (bindat-get-field instr 'offset)))
+ ((func-name (gdb-mi--field instr 'func-name))
+ (offset (gdb-mi--field instr 'offset)))
(if func-name
(format "<%s+%s>:" func-name offset)
""))
- (bindat-get-field instr 'inst)))
- (when (string-equal (bindat-get-field instr 'address)
+ (gdb-mi--field instr 'inst)))
+ (when (string-equal (gdb-mi--field instr 'address)
address)
(progn
(setq marked-line (length (gdb-table-rows table)))
@@ -3913,15 +4057,15 @@ DOC is an optional documentation string."
(setq mode-name
(gdb-current-context-mode-name
(concat "Disassembly: "
- (bindat-get-field (gdb-current-buffer-frame) 'func))))))
+ (gdb-mi--field (gdb-current-buffer-frame) 'func))))))
(defun gdb-disassembly-place-breakpoints ()
(gdb-remove-breakpoint-icons (point-min) (point-max))
(dolist (breakpoint gdb-breakpoints-list)
(let* ((breakpoint (cdr breakpoint))
- (bptno (bindat-get-field breakpoint 'number))
- (flag (bindat-get-field breakpoint 'enabled))
- (address (bindat-get-field breakpoint 'addr)))
+ (bptno (gdb-mi--field breakpoint 'number))
+ (flag (gdb-mi--field breakpoint 'enabled))
+ (address (gdb-mi--field breakpoint 'addr)))
(save-excursion
(goto-char (point-min))
(if (re-search-forward (concat "^" address) nil t)
@@ -3951,10 +4095,10 @@ DOC is an optional documentation string."
(let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
(if breakpoint
(gud-basic-call
- (concat (if (equal "y" (bindat-get-field breakpoint 'enabled))
+ (concat (if (equal "y" (gdb-mi--field breakpoint 'enabled))
"-break-disable "
"-break-enable ")
- (bindat-get-field breakpoint 'number)))
+ (gdb-mi--field breakpoint 'number)))
(error "Not recognized as break/watchpoint line")))))
(defun gdb-delete-breakpoint ()
@@ -3965,7 +4109,7 @@ DOC is an optional documentation string."
(let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
(if breakpoint
(gud-basic-call (concat "-break-delete "
- (bindat-get-field breakpoint 'number)))
+ (gdb-mi--field breakpoint 'number)))
(error "Not recognized as break/watchpoint line")))))
(defun gdb-goto-breakpoint (&optional event)
@@ -3979,16 +4123,14 @@ DOC is an optional documentation string."
(beginning-of-line)
(let ((breakpoint (get-text-property (point) 'gdb-breakpoint)))
(if breakpoint
- (let ((bptno (bindat-get-field breakpoint 'number))
- (file (bindat-get-field breakpoint 'fullname))
- (line (bindat-get-field breakpoint 'line)))
+ (let ((bptno (gdb-mi--field breakpoint 'number))
+ (file (gdb-mi--field breakpoint 'fullname))
+ (line (gdb-mi--field breakpoint 'line)))
(save-selected-window
(let* ((buffer (find-file-noselect
(if (file-exists-p file) file
(cdr (assoc bptno gdb-location-alist)))))
- (window (or (gdb-display-source-buffer buffer)
- (display-buffer buffer))))
- (setq gdb-source-window window)
+ (window (gdb-display-source-buffer buffer)))
(with-current-buffer buffer
(goto-char (point-min))
(forward-line (1- (string-to-number line)))
@@ -4014,28 +4156,28 @@ DOC is an optional documentation string."
FRAME must have either \"file\" and \"line\" members or \"from\"
member."
- (let ((file (bindat-get-field frame 'file))
- (line (bindat-get-field frame 'line))
- (from (bindat-get-field frame 'from)))
+ (let ((file (gdb-mi--field frame 'file))
+ (line (gdb-mi--field frame 'line))
+ (from (gdb-mi--field frame 'from)))
(let ((res (or (and file line (concat file ":" line))
from)))
(if res (concat " of " res) ""))))
(defun gdb-stack-list-frames-custom ()
- (let ((stack (bindat-get-field (gdb-json-partial-output "frame") 'stack))
+ (let ((stack (gdb-mi--field (gdb-mi--partial-output 'frame) 'stack))
(table (make-gdb-table)))
(set-marker gdb-stack-position nil)
(dolist (frame stack)
(gdb-table-add-row table
(list
- (bindat-get-field frame 'level)
+ (gdb-mi--field frame 'level)
"in"
(concat
- (bindat-get-field frame 'func)
+ (gdb-mi--field frame 'func)
(if gdb-stack-buffer-locations
(gdb-frame-location frame) "")
(if gdb-stack-buffer-addresses
- (concat " at " (bindat-get-field frame 'addr)) "")))
+ (concat " at " (gdb-mi--field frame 'addr)) "")))
`(mouse-face highlight
help-echo "mouse-2, RET: Select frame"
gdb-frame ,frame)))
@@ -4095,7 +4237,7 @@ member."
(let ((frame (get-text-property (point) 'gdb-frame)))
(if frame
(if (gdb-buffer-shows-main-thread-p)
- (let ((new-level (bindat-get-field frame 'level)))
+ (let ((new-level (gdb-mi--field frame 'level)))
(setq gdb-frame-number new-level)
(gdb-input (concat "-stack-select-frame " new-level)
'ignore)
@@ -4141,7 +4283,7 @@ member."
(save-excursion
(if event (posn-set-point (event-end event)))
(beginning-of-line)
- (let* ((var (bindat-get-field
+ (let* ((var (gdb-mi--field
(get-text-property (point) 'gdb-local-variable) 'name))
(value (read-string (format "New value (%s): " var))))
(gud-basic-call
@@ -4150,12 +4292,12 @@ member."
;; Don't display values of arrays or structures.
;; These can be expanded using gud-watch.
(defun gdb-locals-handler-custom ()
- (let ((locals-list (bindat-get-field (gdb-json-partial-output) 'locals))
+ (let ((locals-list (gdb-mi--field (gdb-mi--partial-output) 'locals))
(table (make-gdb-table)))
(dolist (local locals-list)
- (let ((name (bindat-get-field local 'name))
- (value (bindat-get-field local 'value))
- (type (bindat-get-field local 'type)))
+ (let ((name (gdb-mi--field local 'name))
+ (value (gdb-mi--field local 'value))
+ (type (gdb-mi--field local 'type)))
(when (not value)
(setq value "<complex data type>"))
(if (or (not value)
@@ -4181,7 +4323,7 @@ member."
(setq mode-name
(gdb-current-context-mode-name
(concat "Locals: "
- (bindat-get-field (gdb-current-buffer-frame) 'func))))))
+ (gdb-mi--field (gdb-current-buffer-frame) 'func))))))
(defvar gdb-locals-header
(list
@@ -4247,11 +4389,11 @@ member."
(defun gdb-registers-handler-custom ()
(when gdb-register-names
(let ((register-values
- (bindat-get-field (gdb-json-partial-output) 'register-values))
+ (gdb-mi--field (gdb-mi--partial-output) 'register-values))
(table (make-gdb-table)))
(dolist (register register-values)
- (let* ((register-number (bindat-get-field register 'number))
- (value (bindat-get-field register 'value))
+ (let* ((register-number (gdb-mi--field register 'number))
+ (value (gdb-mi--field register 'value))
(register-name (nth (string-to-number register-number)
gdb-register-names)))
(gdb-table-add-row
@@ -4275,8 +4417,7 @@ member."
(save-excursion
(if event (posn-set-point (event-end event)))
(beginning-of-line)
- (let* ((var (bindat-get-field
- (get-text-property (point) 'gdb-register-name)))
+ (let* ((var (get-text-property (point) 'gdb-register-name))
(value (read-string (format "New value (%s): " var))))
(gud-basic-call
(concat "-gdb-set variable $" var " = " value)))))
@@ -4338,7 +4479,7 @@ member."
(defun gdb-changed-registers-handler ()
(setq gdb-changed-registers nil)
(dolist (register-number
- (bindat-get-field (gdb-json-partial-output) 'changed-registers))
+ (gdb-mi--field (gdb-mi--partial-output) 'changed-registers))
(push register-number gdb-changed-registers)))
(defun gdb-register-names-handler ()
@@ -4346,7 +4487,7 @@ member."
;; only once (in gdb-init-1)
(setq gdb-register-names nil)
(dolist (register-name
- (bindat-get-field (gdb-json-partial-output) 'register-names))
+ (gdb-mi--field (gdb-mi--partial-output) 'register-names))
(push register-name gdb-register-names))
(setq gdb-register-names (reverse gdb-register-names)))
@@ -4357,7 +4498,8 @@ If buffers already exist for any of these files, `gud-minor-mode'
is set in them."
(goto-char (point-min))
(while (re-search-forward gdb-source-file-regexp nil t)
- (push (read (match-string 1)) gdb-source-file-list))
+ (push (gdb-mi--c-string-from-string (match-string 1))
+ gdb-source-file-list))
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (member buffer-file-name gdb-source-file-list)
@@ -4373,13 +4515,13 @@ Called from `gdb-update'."
(defun gdb-frame-handler ()
"Set `gdb-selected-frame' and `gdb-selected-file' to show
overlay arrow in source buffer."
- (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame)))
+ (let ((frame (gdb-mi--field (gdb-mi--partial-output) 'frame)))
(when frame
- (setq gdb-selected-frame (bindat-get-field frame 'func))
- (setq gdb-selected-file (bindat-get-field frame 'fullname))
- (setq gdb-frame-number (bindat-get-field frame 'level))
- (setq gdb-frame-address (bindat-get-field frame 'addr))
- (let ((line (bindat-get-field frame 'line)))
+ (setq gdb-selected-frame (gdb-mi--field frame 'func))
+ (setq gdb-selected-file (gdb-mi--field frame 'fullname))
+ (setq gdb-frame-number (gdb-mi--field frame 'level))
+ (setq gdb-frame-address (gdb-mi--field frame 'addr))
+ (let ((line (gdb-mi--field frame 'line)))
(setq gdb-selected-line (and line (string-to-number line)))
(when (and gdb-selected-file gdb-selected-line)
(setq gud-last-frame (cons gdb-selected-file gdb-selected-line))
@@ -4404,7 +4546,7 @@ overlay arrow in source buffer."
(goto-char (point-min))
(setq gdb-prompt-name nil)
(re-search-forward gdb-prompt-name-regexp nil t)
- (setq gdb-prompt-name (read (match-string 1)))
+ (setq gdb-prompt-name (gdb-mi--c-string-from-string (match-string 1)))
;; Insert first prompt.
(setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
@@ -4441,17 +4583,17 @@ SPLIT-HORIZONTAL and show BUF in the new window."
(let* ((buf-type (gdb-buffer-type buf))
(existing-window
(get-window-with-predicate
- #'(lambda (w)
- (and (eq buf-type
- (gdb-buffer-type (window-buffer w)))
- (not (window-dedicated-p w)))))))
+ (lambda (w)
+ (and (eq buf-type
+ (gdb-buffer-type (window-buffer w)))
+ (not (window-dedicated-p w)))))))
(if existing-window
(set-window-buffer existing-window buf)
(let ((dedicated-window
(get-window-with-predicate
- #'(lambda (w)
- (eq buf-type
- (gdb-buffer-type (window-buffer w)))))))
+ (lambda (w)
+ (eq buf-type
+ (gdb-buffer-type (window-buffer w)))))))
(if dedicated-window
(set-window-buffer
(split-window dedicated-window nil split-horizontal) buf)
@@ -4464,6 +4606,26 @@ SPLIT-HORIZONTAL and show BUF in the new window."
(define-key gud-menu-map [displays]
`(menu-item "GDB-Windows" ,menu
:visible (eq gud-minor-mode 'gdbmi)))
+ (define-key menu [gdb-restore-windows]
+ '(menu-item "Restore Initial Layout" gdb-restore-windows
+ :help "Restore the initial GDB window layout."))
+ ;; Window layout vs window configuration: We use "window layout" in
+ ;; GDB UI. Internally we refer to "window configuration" because
+ ;; that's the data structure used to store window layouts. Though
+ ;; bare in mind that there is a small difference between what we
+ ;; store and what normal window configuration functions
+ ;; output. Because GDB buffers (source, local, breakpoint, etc) are
+ ;; different between each debugging sessions, simply save/load
+ ;; window configurations doesn't
+ ;; work. `gdb-save-window-configuration' and
+ ;; `gdb-load-window-configuration' do some tricks to store and
+ ;; recreate each buffer in the layout.
+ (define-key menu [load-layout] '("Load Layout" "Load GDB window configuration (layout) from a file" . gdb-load-window-configuration))
+ (define-key menu [save-layout] '("Save Layout" "Save current GDB window configuration (layout) to a file" . gdb-save-window-configuration))
+ (define-key menu [restore-layout-after-quit]
+ '(menu-item "Restore Layout After Quit" gdb-toggle-restore-window-configuration
+ :button (:toggle . gdb-restore-window-configuration-after-quit)
+ :help "Toggle between always restore the window configuration (layout) after GDB quits and never restore.\n You can also change this setting in Customize to conditionally restore."))
(define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
(define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
(define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
@@ -4496,44 +4658,41 @@ SPLIT-HORIZONTAL and show BUF in the new window."
(let ((menu (make-sparse-keymap "GDB-MI")))
(define-key menu [gdb-customize]
- '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb))
+ `(menu-item "Customize" ,(lambda () (interactive) (customize-group 'gdb))
:help "Customize Gdb Graphical Mode options."))
(define-key menu [gdb-many-windows]
'(menu-item "Display Other Windows" gdb-many-windows
:help "Toggle display of locals, stack and breakpoint information"
:button (:toggle . gdb-many-windows)))
- (define-key menu [gdb-restore-windows]
- '(menu-item "Restore Window Layout" gdb-restore-windows
- :help "Restore standard layout for debug session."))
(define-key menu [sep1]
'(menu-item "--"))
(define-key menu [all-threads]
- '(menu-item "GUD controls all threads"
- (lambda ()
- (interactive)
- (setq gdb-gud-control-all-threads t))
+ `(menu-item "GUD controls all threads"
+ ,(lambda ()
+ (interactive)
+ (setq gdb-gud-control-all-threads t))
:help "GUD start/stop commands apply to all threads"
:button (:radio . gdb-gud-control-all-threads)))
(define-key menu [current-thread]
- '(menu-item "GUD controls current thread"
- (lambda ()
- (interactive)
- (setq gdb-gud-control-all-threads nil))
+ `(menu-item "GUD controls current thread"
+ ,(lambda ()
+ (interactive)
+ (setq gdb-gud-control-all-threads nil))
:help "GUD start/stop commands apply to current thread only"
:button (:radio . (not gdb-gud-control-all-threads))))
(define-key menu [sep2]
'(menu-item "--"))
(define-key menu [gdb-customize-reasons]
- '(menu-item "Customize switching..."
- (lambda ()
- (interactive)
- (customize-option 'gdb-switch-reasons))))
+ `(menu-item "Customize switching..."
+ ,(lambda ()
+ (interactive)
+ (customize-option 'gdb-switch-reasons))))
(define-key menu [gdb-switch-when-another-stopped]
- (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped
- gdb-switch-when-another-stopped
- "Automatically switch to stopped thread"
- "GDB thread switching %s"
- "Switch to stopped thread"))
+ (menu-bar-make-toggle-command
+ gdb-toggle-switch-when-another-stopped
+ gdb-switch-when-another-stopped
+ "Automatically switch to stopped thread"
+ "GDB thread switching %s" "Switch to stopped thread"))
(define-key gud-menu-map [mi]
`(menu-item "GDB-MI" ,menu :visible (eq gud-minor-mode 'gdbmi))))
@@ -4579,41 +4738,173 @@ window is dedicated."
(set-window-buffer window (get-buffer name))
(set-window-dedicated-p window t))
+(defun gdb-toggle-restore-window-configuration ()
+ "Toggle whether to restore window configuration when GDB quits."
+ (interactive)
+ (setq gdb-restore-window-configuration-after-quit
+ (not gdb-restore-window-configuration-after-quit)))
+
+(defun gdb-get-source-buffer ()
+ "Return a buffer displaying source file or nil if we can't find one.
+The source file is the file that contains the source location
+where GDB stops. There could be multiple source files during a
+debugging session, we get the most recently showed one. If
+program hasn't started running yet, the source file is the \"main
+file\" where the GDB session starts (see `gdb-main-file')."
+ (if gud-last-last-frame
+ (gud-find-file (car gud-last-last-frame))
+ (when gdb-main-file
+ (gud-find-file gdb-main-file))))
+
(defun gdb-setup-windows ()
- "Layout the window pattern for option `gdb-many-windows'."
- (gdb-get-buffer-create 'gdb-locals-buffer)
- (gdb-get-buffer-create 'gdb-stack-buffer)
- (gdb-get-buffer-create 'gdb-breakpoints-buffer)
- (set-window-dedicated-p (selected-window) nil)
- (switch-to-buffer gud-comint-buffer)
- (delete-other-windows)
- (let ((win0 (selected-window))
- (win1 (split-window nil ( / ( * (window-height) 3) 4)))
- (win2 (split-window nil ( / (window-height) 3)))
- (win3 (split-window-right)))
- (gdb-set-window-buffer (gdb-locals-buffer-name) nil win3)
- (select-window win2)
- (set-window-buffer
- win2
- (if gud-last-last-frame
- (gud-find-file (car gud-last-last-frame))
- (if gdb-main-file
- (gud-find-file gdb-main-file)
- ;; Put buffer list in window if we
- ;; can't find a source file.
- (list-buffers-noselect))))
- (setq gdb-source-window (selected-window))
- (let ((win4 (split-window-right)))
- (gdb-set-window-buffer
- (gdb-get-buffer-create 'gdb-inferior-io) nil win4))
- (select-window win1)
- (gdb-set-window-buffer (gdb-stack-buffer-name))
- (let ((win5 (split-window-right)))
- (gdb-set-window-buffer (if gdb-show-threads-by-default
- (gdb-threads-buffer-name)
- (gdb-breakpoints-buffer-name))
- nil win5))
- (select-window win0)))
+ "Lay out the window pattern for option `gdb-many-windows'."
+ (if gdb-default-window-configuration-file
+ (gdb-load-window-configuration
+ (if (file-name-absolute-p gdb-default-window-configuration-file)
+ gdb-default-window-configuration-file
+ (expand-file-name gdb-default-window-configuration-file
+ gdb-window-configuration-directory)))
+ ;; Create default layout as before.
+ (gdb-get-buffer-create 'gdb-locals-buffer)
+ (gdb-get-buffer-create 'gdb-stack-buffer)
+ (gdb-get-buffer-create 'gdb-breakpoints-buffer)
+ (set-window-dedicated-p (selected-window) nil)
+ (switch-to-buffer gud-comint-buffer)
+ (delete-other-windows)
+ (let ((win0 (selected-window))
+ (win1 (split-window nil ( / ( * (window-height) 3) 4)))
+ (win2 (split-window nil ( / (window-height) 3)))
+ (win3 (split-window-right)))
+ (gdb-set-window-buffer (gdb-locals-buffer-name) nil win3)
+ (select-window win2)
+ (set-window-buffer win2 (or (gdb-get-source-buffer)
+ (list-buffers-noselect)))
+ (setq gdb-source-window-list (list (selected-window)))
+ (let ((win4 (split-window-right)))
+ (gdb-set-window-buffer
+ (gdb-get-buffer-create 'gdb-inferior-io) nil win4))
+ (select-window win1)
+ (gdb-set-window-buffer (gdb-stack-buffer-name))
+ (let ((win5 (split-window-right)))
+ (gdb-set-window-buffer (if gdb-show-threads-by-default
+ (gdb-threads-buffer-name)
+ (gdb-breakpoints-buffer-name))
+ nil win5))
+ (select-window win0))))
+
+(defun gdb-buffer-p (buffer)
+ "Return t if BUFFER is GDB-related."
+ (with-current-buffer buffer
+ (eq gud-minor-mode 'gdbmi)))
+
+(defun gdb-function-buffer-p (buffer)
+ "Return t if BUFFER is a GDB function buffer.
+
+Function buffers are locals buffer, registers buffer, etc, but
+not including main command buffer (the one where you type GDB
+commands) or source buffers (that display program source code)."
+ (with-current-buffer buffer
+ (derived-mode-p 'gdb-parent-mode 'gdb-inferior-io-mode)))
+
+(defun gdb--buffer-type (buffer)
+ "Return the type of BUFFER if it is a function buffer.
+Buffer type is like `gdb-registers-type', `gdb-stack-buffer'.
+These symbols are used by `gdb-get-buffer-create'.
+
+Return nil if BUFFER is not a GDB function buffer."
+ (with-current-buffer buffer
+ (cl-loop for rule in gdb-buffer-rules
+ for mode-name = (gdb-rules-buffer-mode rule)
+ for type = (car rule)
+ if (eq mode-name major-mode)
+ return type
+ finally return nil)))
+
+(defun gdb-save-window-configuration (file)
+ "Save current window configuration (layout) to FILE.
+You can later restore this configuration from that file by
+`gdb-load-window-configuration'."
+ (interactive (list (read-file-name
+ "Save window configuration to file: "
+ (or gdb-window-configuration-directory
+ default-directory))))
+ ;; We replace the buffer in each window with a placeholder, store
+ ;; the buffer type (register, breakpoint, etc) in window parameters,
+ ;; and write the window configuration to the file.
+ (save-window-excursion
+ (let ((placeholder (get-buffer-create " *gdb-placeholder*"))
+ (window-persistent-parameters
+ (cons '(gdb-buffer-type . writable) window-persistent-parameters)))
+ (unwind-protect
+ (dolist (win (window-list nil 'no-minibuffer))
+ (select-window win)
+ (when (gdb-buffer-p (current-buffer))
+ (set-window-parameter
+ nil 'gdb-buffer-type
+ (cond ((gdb-function-buffer-p (current-buffer))
+ ;; 1) If a user arranged the window
+ ;; configuration herself and saves it, windows
+ ;; are probably not dedicated. 2) We use the
+ ;; same dedication flag as in
+ ;; `gdb-display-buffer'.
+ (set-window-dedicated-p nil t)
+ ;; We save this gdb-buffer-type symbol so
+ ;; we can later pass it to `gdb-get-buffer-create';
+ ;; one example: `gdb-registers-buffer'.
+ (or (gdb--buffer-type (current-buffer))
+ (error "Unrecognized gdb buffer mode: %s" major-mode)))
+ ;; Command buffer.
+ ((derived-mode-p 'gud-mode) 'command)
+ ;; Consider everything else as source buffer.
+ (t 'source)))
+ (with-window-non-dedicated nil
+ (set-window-buffer nil placeholder)
+ (set-window-prev-buffers (selected-window) nil)
+ (set-window-next-buffers (selected-window) nil))))
+ ;; Save the window configuration to FILE.
+ (let ((window-config (window-state-get nil t)))
+ (with-temp-buffer
+ (prin1 window-config (current-buffer))
+ (write-file file t)))
+ (kill-buffer placeholder)))))
+
+(defun gdb-load-window-configuration (file)
+ "Restore window configuration (layout) from FILE.
+FILE should be a window configuration file saved by
+`gdb-save-window-configuration'."
+ (interactive (list (read-file-name
+ "Restore window configuration from file: "
+ (or gdb-window-configuration-directory
+ default-directory))))
+ ;; Basically, we restore window configuration and go through each
+ ;; window and restore the function buffers.
+ (let* ((placeholder (get-buffer-create " *gdb-placeholder*")))
+ (unwind-protect ; Don't leak buffer.
+ (let ((window-config (with-temp-buffer
+ (insert-file-contents file)
+ ;; We need to go to point-min because
+ ;; `read' reads from point
+ (goto-char (point-min))
+ (read (current-buffer))))
+ (source-buffer (or (gdb-get-source-buffer)
+ ;; Do the same thing as in
+ ;; `gdb-setup-windows' if no source
+ ;; buffer is found.
+ (list-buffers-noselect)))
+ buffer-type)
+ (window-state-put window-config (frame-root-window))
+ (dolist (window (window-list nil 'no-minibuffer))
+ (with-selected-window window
+ (setq buffer-type (window-parameter nil 'gdb-buffer-type))
+ (pcase buffer-type
+ ('source (when source-buffer
+ (set-window-buffer nil source-buffer)
+ (push (selected-window) gdb-source-window-list)))
+ ('command (switch-to-buffer gud-comint-buffer))
+ (_ (let ((buffer (gdb-get-buffer-create buffer-type)))
+ (with-window-non-dedicated nil
+ (set-window-buffer nil buffer))))))))
+ (kill-buffer placeholder))))
(define-minor-mode gdb-many-windows
"If nil just pop up the GUD buffer unless `gdb-show-main' is t.
@@ -4631,7 +4922,12 @@ of the debugged program. Non-nil means display the layout shown for
(defun gdb-restore-windows ()
"Restore the basic arrangement of windows used by gdb.
-This arrangement depends on the value of option `gdb-many-windows'."
+This arrangement depends on the values of variable
+`gdb-many-windows' and `gdb-default-window-configuration-file'."
+ ;; This function is used when the user messed up window
+ ;; configuration and wants to "reset to default". The function that
+ ;; sets up window configuration on start up is
+ ;; `gdb-get-source-file'.
(interactive)
(switch-to-buffer gud-comint-buffer) ;Select the right window and frame.
(delete-other-windows)
@@ -4644,7 +4940,7 @@ This arrangement depends on the value of option `gdb-many-windows'."
(if gud-last-last-frame
(gud-find-file (car gud-last-last-frame))
(gud-find-file gdb-main-file)))
- (setq gdb-source-window win)))))
+ (setq gdb-source-window-list (list win))))))
;; Called from `gud-sentinel' in gud.el:
(defun gdb-reset ()
@@ -4678,14 +4974,28 @@ Kills the gdb buffers, and resets variables and the source buffers."
(if (boundp 'speedbar-frame) (speedbar-timer-fn))
(setq gud-running nil)
(setq gdb-active-process nil)
- (remove-hook 'after-save-hook 'gdb-create-define-alist t))
+ (remove-hook 'after-save-hook 'gdb-create-define-alist t)
+ ;; Recover window configuration.
+ (when (or (eq gdb-restore-window-configuration-after-quit t)
+ (and (eq gdb-restore-window-configuration-after-quit
+ 'if-gdb-show-main)
+ gdb-show-main)
+ (and (eq gdb-restore-window-configuration-after-quit
+ 'if-gdb-many-windows)
+ gdb-many-windows))
+ (when gdb--window-configuration-before
+ (window-state-put gdb--window-configuration-before)
+ ;; This way we don't accidentally restore an outdated window
+ ;; configuration.
+ (setq gdb--window-configuration-before nil))))
(defun gdb-get-source-file ()
"Find the source file where the program starts and display it with related
buffers, if required."
+ ;; This function is called only once on startup.
(goto-char (point-min))
(if (re-search-forward gdb-source-file-regexp nil t)
- (setq gdb-main-file (read (match-string 1))))
+ (setq gdb-main-file (gdb-mi--c-string-from-string (match-string 1))))
(if gdb-many-windows
(gdb-setup-windows)
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el
index cad74f9f63a..ab65a1590c0 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -1,4 +1,4 @@
-;;; glasses.el --- make cantReadThis readable
+;;; glasses.el --- make cantReadThis readable -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -66,7 +66,6 @@ defined by `glasses-original-separator'. If you don't want to add missing
separators, set `glasses-separator' to an empty string. If you don't want to
replace existent separators, set `glasses-original-separator' to an empty
string."
- :group 'glasses
:type 'string
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -78,7 +77,6 @@ For instance, if you set it to \"_\" and set `glasses-separator' to \"-\",
underscore separators are displayed as hyphens.
If `glasses-original-separator' is an empty string, no such display change is
performed."
- :group 'glasses
:type 'string
:set 'glasses-custom-set
:initialize 'custom-initialize-default
@@ -92,7 +90,6 @@ If it is nil, no face is placed at the capitalized letter.
For example, you can set `glasses-separator' to an empty string and
`glasses-face' to `bold'. Then unreadable identifiers will have no separators,
but will have their capitals in bold."
- :group 'glasses
:type '(choice (const :tag "None" nil) face)
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -100,7 +97,6 @@ but will have their capitals in bold."
(defcustom glasses-separate-parentheses-p t
"If non-nil, ensure space between an identifier and an opening parenthesis."
- :group 'glasses
:type 'boolean)
(defcustom glasses-separate-parentheses-exceptions
@@ -108,7 +104,6 @@ but will have their capitals in bold."
"List of regexp that are exceptions for `glasses-separate-parentheses-p'.
They are matched to the current line truncated to the point where the
parenthesis expression starts."
- :group 'glasses
:type '(repeat regexp))
(defcustom glasses-separate-capital-groups t
@@ -116,7 +111,6 @@ parenthesis expression starts."
When the value is non-nil, HTMLSomething and IPv6 are displayed
as HTML_Something and I_Pv6 respectively. Set the value to nil
if you prefer to display them unchanged."
- :group 'glasses
:type 'boolean
:version "24.1")
@@ -124,7 +118,6 @@ if you prefer to display them unchanged."
"If non-nil, downcase embedded capital letters in identifiers.
Only identifiers starting with lower case letters are affected, letters inside
other identifiers are unchanged."
- :group 'glasses
:type 'boolean
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -135,7 +128,6 @@ other identifiers are unchanged."
Only words starting with this regexp are uncapitalized.
The regexp is case sensitive.
It has any effect only when `glasses-uncapitalize-p' is non-nil."
- :group 'glasses
:type 'regexp
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -149,7 +141,6 @@ file write then.
Note the removal action does not try to be much clever, so it can remove real
separators too."
- :group 'glasses
:type 'boolean)
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index d4aca28bd7c..96838269749 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -64,8 +64,7 @@ SYMBOL should be one of `grep-command', `grep-template',
"Number of lines in a grep window. If nil, use `compilation-window-height'."
:type '(choice (const :tag "Default" nil)
integer)
- :version "22.1"
- :group 'grep)
+ :version "22.1")
(defcustom grep-highlight-matches 'auto-detect
"Use special markers to highlight grep matches.
@@ -98,9 +97,15 @@ To change the default value, use \\[customize] or call the function
(const :tag "Use --color=always" always)
(const :tag "Use --color" auto)
(other :tag "Not Set" auto-detect))
- :set 'grep-apply-setting
- :version "22.1"
- :group 'grep)
+ :set #'grep-apply-setting
+ :version "22.1")
+
+(defcustom grep-match-regexp "\033\\[0?1;31m\\(.*?\\)\033\\[[0-9]*m"
+ "Regular expression matching grep markers to highlight.
+It matches SGR ANSI escape sequences which are emitted by grep to
+color its output. This variable is used in `grep-filter'."
+ :type 'regexp
+ :version "28.1")
(defcustom grep-scroll-output nil
"Non-nil to scroll the *grep* buffer window as output appears.
@@ -109,8 +114,7 @@ Setting it causes the grep commands to put point at the end of their
output window so that the end of the output is always visible rather
than the beginning."
:type 'boolean
- :version "22.1"
- :group 'grep)
+ :version "22.1")
;;;###autoload
(defcustom grep-command nil
@@ -124,8 +128,7 @@ by `grep-compute-defaults'; to change the default value, use
\\[customize] or call the function `grep-apply-setting'."
:type '(choice string
(const :tag "Not Set" nil))
- :set 'grep-apply-setting
- :group 'grep)
+ :set #'grep-apply-setting)
(defcustom grep-template nil
"The default command to run for \\[lgrep].
@@ -141,9 +144,8 @@ by `grep-compute-defaults'; to change the default value, use
\\[customize] or call the function `grep-apply-setting'."
:type '(choice string
(const :tag "Not Set" nil))
- :set 'grep-apply-setting
- :version "22.1"
- :group 'grep)
+ :set #'grep-apply-setting
+ :version "22.1")
(defcustom grep-use-null-device 'auto-detect
"If t, append the value of `null-device' to `grep' commands.
@@ -157,8 +159,7 @@ by `grep-compute-defaults'; to change the default value, use
:type '(choice (const :tag "Do Not Append Null Device" nil)
(const :tag "Append Null Device" t)
(other :tag "Not Set" auto-detect))
- :set 'grep-apply-setting
- :group 'grep)
+ :set #'grep-apply-setting)
(defcustom grep-use-null-filename-separator 'auto-detect
"If non-nil, use `grep's `--null' option.
@@ -167,19 +168,23 @@ This is done to disambiguate file names in `grep's output."
:type '(choice (const :tag "Do Not Use `--null'" nil)
(const :tag "Use `--null'" t)
(other :tag "Not Set" auto-detect))
- :set 'grep-apply-setting
- :group 'grep)
+ :set #'grep-apply-setting)
;;;###autoload
(defcustom grep-find-command nil
"The default find command for \\[grep-find].
In interactive usage, the actual value of this variable is set up
by `grep-compute-defaults'; to change the default value, use
-\\[customize] or call the function `grep-apply-setting'."
+\\[customize] or call the function `grep-apply-setting'.
+
+This variable can either be a string, or a cons of the
+form (COMMAND . POSITION). In the latter case, COMMAND will be
+used as the default command, and point will be placed at POSITION
+for easier editing."
:type '(choice string
+ (cons string integer)
(const :tag "Not Set" nil))
- :set 'grep-apply-setting
- :group 'grep)
+ :set #'grep-apply-setting)
(defcustom grep-find-template nil
"The default command to run for \\[rgrep].
@@ -194,9 +199,8 @@ by `grep-compute-defaults'; to change the default value, use
\\[customize] or call the function `grep-apply-setting'."
:type '(choice string
(const :tag "Not Set" nil))
- :set 'grep-apply-setting
- :version "22.1"
- :group 'grep)
+ :set #'grep-apply-setting
+ :version "22.1")
(defcustom grep-files-aliases
'(("all" . "* .[!.]* ..?*") ;; Don't match `..'. See bug#22577
@@ -213,8 +217,7 @@ by `grep-compute-defaults'; to change the default value, use
("texi" . "*.texi")
("asm" . "*.[sS]"))
"Alist of aliases for the FILES argument to `lgrep' and `rgrep'."
- :type 'alist
- :group 'grep)
+ :type 'alist)
(defcustom grep-find-ignored-directories vc-directory-exclusion-list
"List of names of sub-directories which `rgrep' shall not recurse into.
@@ -223,8 +226,7 @@ to determine whether cdr should not be recursed into.
The default value is inherited from `vc-directory-exclusion-list'."
:type '(choice (repeat :tag "Ignored directories" string)
- (const :tag "No ignored directories" nil))
- :group 'grep)
+ (const :tag "No ignored directories" nil)))
(defcustom grep-find-ignored-files
(cons ".#*" (delq nil (mapcar (lambda (s)
@@ -235,8 +237,7 @@ The default value is inherited from `vc-directory-exclusion-list'."
If an element is a cons cell, the car is called on the search directory
to determine whether cdr should not be excluded."
:type '(choice (repeat :tag "Ignored file" string)
- (const :tag "No ignored files" nil))
- :group 'grep)
+ (const :tag "No ignored files" nil)))
(defcustom grep-save-buffers 'ask
"If non-nil, save buffers before running the grep commands.
@@ -251,22 +252,19 @@ to limit saving to files located under `my-grep-root'."
(const :tag "Ask before saving" ask)
(const :tag "Don't save buffers" nil)
function
- (other :tag "Save all buffers" t))
- :group 'grep)
+ (other :tag "Save all buffers" t)))
(defcustom grep-error-screen-columns nil
"If non-nil, column numbers in grep hits are screen columns.
See `compilation-error-screen-columns'."
:type '(choice (const :tag "Default" nil)
integer)
- :version "22.1"
- :group 'grep)
+ :version "22.1")
;;;###autoload
(defcustom grep-setup-hook nil
"List of hook functions run by `grep-process-setup' (see `run-hooks')."
- :type 'hook
- :group 'grep)
+ :type 'hook)
(defvar grep-mode-map
(let ((map (make-sparse-keymap)))
@@ -333,7 +331,10 @@ See `compilation-error-screen-columns'."
;; When bootstrapping, tool-bar-map is not properly initialized yet,
;; so don't do anything.
(when (keymapp (butlast tool-bar-map))
+ ;; We have to `copy-keymap' rather than use keymap inheritance because
+ ;; we want to put the new items at the *end* of the tool-bar.
(let ((map (butlast (copy-keymap tool-bar-map)))
+ ;; FIXME: Nowadays the last button is not "help" but "search"!
(help (last tool-bar-map))) ;; Keep Help last in tool bar
(tool-bar-local-item
"left-arrow" 'previous-error-no-select 'previous-error-no-select map
@@ -439,15 +440,13 @@ and reveals the entire command line. The visibility of the
abbreviated part can also be toggled with
`grep-find-toggle-abbreviation'."
:type 'boolean
- :version "27.1"
- :group 'grep)
+ :version "27.1")
(defcustom grep-search-path '(nil)
"List of directories to search for files named in grep messages.
Elements should be directory names, not file names of
directories. The value nil as an element means the grep messages
buffer `default-directory'."
- :group 'grep
:version "27.1"
:type '(repeat (choice (const :tag "Default" nil)
(string :tag "Directory"))))
@@ -528,9 +527,8 @@ This variable's value takes effect when `grep-compute-defaults' is called."
(const :tag "find -print0 | sort -z | xargs -0'" gnu-sort)
string
(const :tag "Not Set" nil))
- :set 'grep-apply-setting
- :version "27.1"
- :group 'grep)
+ :set #'grep-apply-setting
+ :version "27.1")
;; History of grep commands.
;;;###autoload
@@ -562,7 +560,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
(setenv "GREP_COLORS" "mt=01;31:fn=:ln=:bn=:se=:sl=:cx=:ne"))
(setq-local grep-num-matches-found 0)
(set (make-local-variable 'compilation-exit-message-function)
- 'grep-exit-message)
+ #'grep-exit-message)
(run-hooks 'grep-setup-hook))
(defun grep-exit-message (status code msg)
@@ -599,7 +597,7 @@ This function is called from `compilation-filter-hook'."
(when (< (point) end)
(setq end (copy-marker end))
;; Highlight grep matches and delete marking sequences.
- (while (re-search-forward "\033\\[0?1;31m\\(.*?\\)\033\\[[0-9]*m" end 1)
+ (while (re-search-forward grep-match-regexp end 1)
(replace-match (propertize (match-string 1)
'face nil 'font-lock-face grep-match-face)
t t)
@@ -612,7 +610,7 @@ This function is called from `compilation-filter-hook'."
(defun grep-probe (command args &optional func result)
(let (process-file-side-effects)
(equal (condition-case nil
- (apply (or func 'process-file) command args)
+ (apply (or func #'process-file) command args)
(error nil))
(or result 0))))
@@ -705,10 +703,10 @@ The value depends on `grep-command', `grep-template',
(let ((grep-options
(concat (if grep-use-null-device "-n" "-nH")
(if grep-use-null-filename-separator " --null")
- (if (grep-probe grep-program
- `(nil nil nil "-e" "foo" ,null-device)
- nil 1)
- " -e"))))
+ (when (grep-probe grep-program
+ `(nil nil nil "-e" "foo" ,null-device)
+ nil 1)
+ " -e"))))
(unless grep-command
(setq grep-command
(format "%s %s %s " grep-program
@@ -808,7 +806,7 @@ The value depends on `grep-command', `grep-template',
(buffer-substring-no-properties (point) (mark)))
(funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
- 'find-tag-default))
+ #'find-tag-default))
""))
(defun grep-default-command ()
@@ -863,11 +861,11 @@ The value depends on `grep-command', `grep-template',
(set (make-local-variable 'compilation-directory-matcher)
(list regexp-unmatchable))
(set (make-local-variable 'compilation-process-setup-function)
- 'grep-process-setup)
+ #'grep-process-setup)
(set (make-local-variable 'compilation-disable-input) t)
(set (make-local-variable 'compilation-error-screen-columns)
grep-error-screen-columns)
- (add-hook 'compilation-filter-hook 'grep-filter nil t))
+ (add-hook 'compilation-filter-hook #'grep-filter nil t))
(defun grep--save-buffers ()
(when grep-save-buffers
@@ -914,7 +912,7 @@ list is empty)."
(compilation-start (if (and grep-use-null-device null-device)
(concat command-args " " null-device)
command-args)
- 'grep-mode))
+ #'grep-mode))
;;;###autoload
@@ -961,10 +959,10 @@ The substitution is based on variables bound dynamically, and
these include `opts', `dir', `files', `null-device', `excl' and
`regexp'.")
-(defun grep-expand-template (template &optional regexp files dir excl)
+(defun grep-expand-template (template &optional regexp files dir excl more-opts)
"Expand grep COMMAND string replacing <C>, <D>, <F>, <R>, and <X>."
(let* ((command template)
- (env `((opts . ,(let (opts)
+ (env `((opts . ,(let ((opts more-opts))
(when (and case-fold-search
(isearch-no-upper-case-p regexp t))
(push "-i" opts))
@@ -993,23 +991,31 @@ these include `opts', `dir', `files', `null-device', `excl' and
"Read regexp arg for interactive grep using `read-regexp'."
(read-regexp "Search for" 'grep-tag-default 'grep-regexp-history))
+(defvar grep-read-files-function #'grep-read-files--default)
+
+(defun grep-read-files--default ()
+ ;; Instead of a `grep-read-files-function' variable, we used to lookup
+ ;; mode-specific functions in the major mode's symbol properties, so preserve
+ ;; this behavior for backward compatibility.
+ (let ((old-function (get major-mode 'grep-read-files))) ;Obsolete since 28.1
+ (if old-function
+ (funcall old-function)
+ (let ((file-name-at-point
+ (run-hook-with-args-until-success 'file-name-at-point-functions)))
+ (or (if (and (stringp file-name-at-point)
+ (not (file-directory-p file-name-at-point)))
+ file-name-at-point)
+ (buffer-file-name)
+ (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name)))))))
+
(defun grep-read-files (regexp)
"Read a file-name pattern arg for interactive grep.
-The pattern can include shell wildcards. As whitespace triggers
+The pattern can include shell wildcards. As SPC can triggers
completion when entering a pattern, including it requires
quoting, e.g. `\\[quoted-insert]<space>'.
REGEXP is used as a string in the prompt."
- (let* ((grep-read-files-function (get major-mode 'grep-read-files))
- (file-name-at-point
- (run-hook-with-args-until-success 'file-name-at-point-functions))
- (bn (if grep-read-files-function
- (funcall grep-read-files-function)
- (or (if (and (stringp file-name-at-point)
- (not (file-directory-p file-name-at-point)))
- file-name-at-point)
- (buffer-file-name)
- (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name)))))
+ (let* ((bn (funcall grep-read-files-function))
(fn (and bn
(stringp bn)
(file-name-nondirectory bn)))
@@ -1022,7 +1028,7 @@ REGEXP is used as a string in the prompt."
(setq alias (car aliases)
aliases (cdr aliases))
(if (string-match (mapconcat
- 'wildcard-to-regexp
+ #'wildcard-to-regexp
(split-string (cdr alias) nil t)
"\\|")
fn)
@@ -1043,15 +1049,17 @@ REGEXP is used as a string in the prompt."
"\" in files matching wildcard"
(if default (concat " (default " default ")"))
": ")
- 'read-file-name-internal
+ #'read-file-name-internal
nil nil nil 'grep-files-history
(delete-dups
(delq nil (append (list default default-alias default-extension)
- (mapcar 'car grep-files-aliases)))))))
+ (mapcar #'car grep-files-aliases)))))))
(and files
(or (cdr (assoc files grep-files-aliases))
files))))
+(defvar grep-use-directories-skip 'auto-detect)
+
;;;###autoload
(defun lgrep (regexp &optional files dir confirm)
"Run grep, searching for REGEXP in FILES in directory DIR.
@@ -1097,6 +1105,12 @@ command before it's run."
(if (string= command grep-command)
(setq command nil))
(setq dir (file-name-as-directory (expand-file-name dir)))
+ (unless (or (not grep-use-directories-skip) (eq grep-use-directories-skip t))
+ (setq grep-use-directories-skip
+ (grep-probe grep-program
+ `(nil nil nil "--directories=skip" "foo"
+ ,null-device)
+ nil 1)))
(setq command (grep-expand-template
grep-template
regexp
@@ -1113,7 +1127,9 @@ command before it's run."
(shell-quote-argument
(cdr ignore))))))
grep-find-ignored-files
- " --exclude=")))))
+ " --exclude=")))
+ (and (eq grep-use-directories-skip t)
+ '("--directories=skip"))))
(when command
(if confirm
(setq command
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 540bc9ce7f3..81021bc64f4 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -486,9 +486,8 @@ The value t means that there is no stack, and we are in display-file mode.")
"Additional menu items to add to the speedbar frame.")
;; Make sure our special speedbar mode is loaded
-(if (featurep 'speedbar)
- (gud-install-speedbar-variables)
- (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables))
+(with-eval-after-load 'speedbar
+ (gud-install-speedbar-variables))
(defun gud-expansion-speedbar-buttons (_directory _zero)
"Wrapper for call to `speedbar-add-expansion-list'.
@@ -1846,7 +1845,7 @@ and source-file directory for your debugger."
;; JDB command will get out of the debugger. There is some truly
;; pathetic JDB documentation available at:
;;
-;; http://java.sun.com/products/jdk/1.1/debugging/
+;; https://java.sun.com/products/jdk/1.1/debugging/
;;
;; KNOWN PROBLEMS AND FIXME's:
;;
@@ -2359,17 +2358,17 @@ during jdb initialization depending on the value of
(if (< n gud-jdb-lowest-stack-level)
(progn (setq gud-jdb-lowest-stack-level n) t)))
t)
- (if (setq file-found
- (gud-jdb-find-source (match-string 2 gud-marker-acc)))
- (setq gud-last-frame
- (cons file-found
- (string-to-number
- (let
- ((numstr (match-string 4 gud-marker-acc)))
- (if (string-match "[.,]" numstr)
- (replace-match "" nil nil numstr)
- numstr)))))
- (message "Could not find source file.")))
+ (let ((class (match-string 2 gud-marker-acc)))
+ (if (setq file-found (gud-jdb-find-source class))
+ (setq gud-last-frame
+ (cons file-found
+ (string-to-number
+ (let
+ ((numstr (match-string 4 gud-marker-acc)))
+ (if (string-match "[.,]" numstr)
+ (replace-match "" nil nil numstr)
+ numstr)))))
+ (message "Could not find source file for %s" class))))
;; Set the accumulator to the remaining text.
(setq gud-marker-acc (substring gud-marker-acc (match-end 0))))
@@ -2827,9 +2826,13 @@ Obeying it means displaying in another window the specified file and line."
(buffer
(with-current-buffer gud-comint-buffer
(gud-find-file true-file)))
- (window (and buffer
- (or (get-buffer-window buffer)
- (display-buffer buffer '(nil (inhibit-same-window . t))))))
+ (window
+ (when buffer
+ (if (eq gud-minor-mode 'gdbmi)
+ (gdb-display-source-buffer buffer)
+ ;; Gud still has the old behavior.
+ (or (get-buffer-window buffer)
+ (display-buffer buffer '(nil (inhibit-same-window . t)))))))
(pos))
(when buffer
(with-current-buffer buffer
@@ -2859,9 +2862,7 @@ Obeying it means displaying in another window the specified file and line."
(widen)
(goto-char pos))))
(when window
- (set-window-point window gud-overlay-arrow-position)
- (if (eq gud-minor-mode 'gdbmi)
- (setq gdb-source-window window))))))
+ (set-window-point window gud-overlay-arrow-position)))))
;; The gud-call function must do the right thing whether its invoking
;; keystroke is from the GUD buffer itself (via major-mode binding)
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index f5af277dc5e..25e75235aa4 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -162,7 +162,7 @@ This behavior is generally undesirable. If this option is non-nil, the outermos
"\\.h\\(h\\|xx\\|pp\\|\\+\\+\\)?\\'"
"C/C++ header file name patterns to determine if current buffer is a header.
Effective only if `hide-ifdef-expand-reinclusion-protection' is t."
- :type 'string
+ :type 'regexp
:version "25.1")
(defvar hide-ifdef-mode-submap
@@ -301,7 +301,7 @@ Several variables affect how the hiding is done:
;; `hide-ifdef-env' is now a global variable.
;; We can still simulate the behavior of older hideif versions (i.e.
;; `hide-ifdef-env' being buffer local) by clearing this variable
- ;; (C-c @ C) everytime before hiding current buffer.
+ ;; (C-c @ C) every time before hiding current buffer.
;; (set (make-local-variable 'hide-ifdef-env)
;; (default-value 'hide-ifdef-env))
(set 'hide-ifdef-env (default-value 'hide-ifdef-env))
@@ -1490,7 +1490,7 @@ Refer to `hide-ifdef-expand-reinclusion-protection' for more details."
(test (hif-canonicalize hif-ifx-regexp))
(range (hif-find-range))
(elifs (hif-range-elif range))
- (if-part t) ; Everytime we start from if-part
+ (if-part t) ; Every time we start from if-part
(complete nil))
;; (message "test = %s" test) (sit-for 1)
@@ -1650,7 +1650,7 @@ first arg will be `hif-etc'."
;; postponed the evaluation process one stage and store the "parsed tree"
;; into symbol database. The evaluation process was then "strings -> tokens
;; -> [parsed tree] -> value". Hideif therefore run slower since it need to
-;; evaluate the parsed tree everytime when trying to expand the symbol. These
+;; evaluate the parsed tree every time when trying to expand the symbol. These
;; temporarily code changes are obsolete and not in Emacs source repository.
;;
;; Furthermore, CPP did allow partial expression to be defined in several
@@ -1659,7 +1659,7 @@ first arg will be `hif-etc'."
;; further, otherwise those partial expression will be fail on parsing and
;; we'll miss all macros that reference it. The evaluation process thus
;; became "strings -> [tokens] -> parsed tree -> value." This degraded the
-;; performance since we need to parse tokens and evaluate them everytime
+;; performance since we need to parse tokens and evaluate them every time
;; when that symbol is referenced.
;;
;; In real cases I found a lot portion of macros are "simple macros" that
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 625e08e4d79..2ad66ccc5e0 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -264,7 +264,10 @@ This has effect only if `search-invisible' is set to `open'."
(c++-mode "{" "}" "/[*/]" nil nil)
(bibtex-mode ("@\\S(*\\(\\s(\\)" 1))
(java-mode "{" "}" "/[*/]" nil nil)
- (js-mode "{" "}" "/[*/]" nil)))
+ (js-mode "{" "}" "/[*/]" nil)
+ (mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil)
+ ;; Add more support here.
+ ))
"Alist for initializing the hideshow variables for different modes.
Each element has the form
(MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC).
diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el
index b0542a99da8..4cb82786aef 100644
--- a/lisp/progmodes/idlw-complete-structtag.el
+++ b/lisp/progmodes/idlw-complete-structtag.el
@@ -49,15 +49,14 @@
;;
;; New versions of IDLWAVE, documentation, and more information available
;; from:
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;; INSTALLATION
;; ============
-;; Put this file on the emacs load path and load it with the following
-;; line in your init file:
+;; Load it with the following line in your init file:
;;
-;; (add-hook 'idlwave-load-hook
-;; (lambda () (require 'idlw-complete-structtag)))
+;; (with-eval-after-load 'idlwave
+;; (require 'idlw-complete-structtag))
;;
;; DESCRIPTION
;; ===========
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 69385d7060f..2d4ea465c42 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -32,7 +32,7 @@
;; along with new versions of IDLWAVE, documentation, and more
;; information, at:
;;
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -182,14 +182,14 @@ definition is displayed instead."
which specifies the `name' section. Can be used for localization
support."
:group 'idlwave-online-help
- :type 'string)
+ :type 'regexp)
(defcustom idlwave-help-doclib-keyword "KEYWORD"
"A regexp for the heading word to search for in doclib headers
which specifies the `keywords' section. Can be used for localization
support."
:group 'idlwave-online-help
- :type 'string)
+ :type 'regexp)
(defface idlwave-help-link
'((t :inherit link))
@@ -267,7 +267,6 @@ support."
(declare-function idlwave-find-class-definition "idlwave")
(declare-function idlwave-find-inherited-class "idlwave")
(declare-function idlwave-find-struct-tag "idlwave")
-(declare-function idlwave-get-buffer-visiting "idlwave")
(declare-function idlwave-in-quote "idlwave")
(declare-function idlwave-make-full-name "idlwave")
(declare-function idlwave-members-only "idlwave")
@@ -880,7 +879,7 @@ This function can be used as `idlwave-extra-help-function'."
(setq in-buf ; structure-tag completion is always in current buffer
(if struct-tag
idlwave-current-tags-buffer
- (idlwave-get-buffer-visiting file)))
+ (find-buffer-visiting file)))
;; see if file is in a visited buffer, insert those contents
(if in-buf
(progn
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index dba70cb2821..38127fccbc3 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -40,7 +40,7 @@
;;
;; New versions of IDLWAVE, documentation, and more information
;; available from:
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;; INSTALLATION:
;; =============
@@ -58,7 +58,7 @@
;; The newest version of this file can be found on the maintainers
;; web site.
;;
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;; DOCUMENTATION
;; =============
@@ -896,7 +896,7 @@ IDL has currently stepped.")
Info documentation for this package is available. Use \\[idlwave-info]
to display (complain to your sysadmin if that does not work).
For PostScript and HTML versions of the documentation, check IDLWAVE's
- homepage at URL `http://github.com/jdtsmith/idlwave'.
+ homepage at URL `https://github.com/jdtsmith/idlwave'.
IDLWAVE has customize support - see the group `idlwave'.
8. Keybindings
@@ -1598,7 +1598,7 @@ number.")
"A regular expression to match any IDL error.")
(defvar idlwave-shell-halting-error
- "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+\\s-*.*\\)\n"
+ "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+.*\\)\n"
"A regular expression to match errors which halt execution.")
(defvar idlwave-shell-cant-continue-error
@@ -2640,7 +2640,7 @@ Assumes that `idlwave-shell-sources-alist' contains an entry for that module."
(if (or (not source-file)
(not (file-regular-p source-file))
(not (setq buf
- (or (idlwave-get-buffer-visiting source-file)
+ (or (find-buffer-visiting source-file)
(find-file-noselect source-file)))))
(progn
(message "The source file for module %s is probably not compiled"
@@ -2745,7 +2745,7 @@ Runs to the last statement and then steps 1 statement. Use the .out command."
;; event. mouse-drag-track does so.
(if drag-track 'mouse-drag-track 'mouse-drag-region)))
(funcall tracker event)
- (idlwave-shell-print (if (idlwave-region-active-p) '(4) nil)
+ (idlwave-shell-print (if (region-active-p) '(4) nil)
,help ,ev))))
;; Begin terrible hack section -- XEmacs tests for button2 explicitly
@@ -2830,7 +2830,7 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key."
(cond
((equal arg '(16))
(setq expr (read-string "Expression: ")))
- ((and (or arg (idlwave-region-active-p))
+ ((and (or arg (region-active-p))
(< (- (region-end) (region-beginning)) 2000))
(setq beg (region-beginning)
end (region-end)))
@@ -3241,8 +3241,7 @@ Does not work for a region with multiline blocks - use
"Delete the temporary files and kill associated buffers."
(if (stringp idlwave-shell-temp-pro-file)
(condition-case nil
- (let ((buf (idlwave-get-buffer-visiting
- idlwave-shell-temp-pro-file)))
+ (let ((buf (find-buffer-visiting idlwave-shell-temp-pro-file)))
(if (buffer-live-p buf)
(kill-buffer buf))
(delete-file idlwave-shell-temp-pro-file))
@@ -3788,7 +3787,7 @@ handled by this command."
(save-buffer)
(setq idlwave-shell-last-save-and-action-file (buffer-file-name)))
(idlwave-shell-last-save-and-action-file
- (if (setq buf (idlwave-get-buffer-visiting
+ (if (setq buf (find-buffer-visiting
idlwave-shell-last-save-and-action-file))
(with-current-buffer buf
(save-buffer))))
diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el
index 23c129c1afc..1866e50d680 100644
--- a/lisp/progmodes/idlw-toolbar.el
+++ b/lisp/progmodes/idlw-toolbar.el
@@ -29,7 +29,7 @@
;; New versions of IDLWAVE, documentation, and more information
;; available from:
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;; Code:
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 2601c2e1653..86f9f336723 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -44,7 +44,7 @@
;;
;; New versions of IDLWAVE, documentation, and more information
;; available from:
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;; INSTALLATION
;; ============
@@ -64,7 +64,7 @@
;; The newest version of this file is available from the maintainer's
;; Webpage:
;;
-;; http://github.com/jdtsmith/idlwave
+;; https://github.com/jdtsmith/idlwave
;;
;; DOCUMENTATION
;; =============
@@ -154,21 +154,6 @@
(eval-when-compile (require 'cl-lib))
(require 'idlw-help)
-;; For XEmacs
-(unless (fboundp 'line-beginning-position)
- (defalias 'line-beginning-position 'point-at-bol))
-(unless (fboundp 'line-end-position)
- (defalias 'line-end-position 'point-at-eol))
-(unless (fboundp 'char-valid-p)
- (defalias 'char-valid-p 'characterp))
-(unless (fboundp 'match-string-no-properties)
- (defalias 'match-string-no-properties 'match-string))
-
-(if (not (fboundp 'cancel-timer))
- (condition-case nil
- (require 'timer)
- (error nil)))
-
(declare-function idlwave-shell-get-path-info "idlw-shell")
(declare-function idlwave-shell-temp-file "idlw-shell")
(declare-function idlwave-shell-is-running "idlw-shell")
@@ -179,7 +164,7 @@
"Major mode for editing IDL .pro files."
:tag "IDLWAVE"
:link '(url-link :tag "Home Page"
- "http://github.com/jdtsmith/idlwave")
+ "https://github.com/jdtsmith/idlwave")
:link '(emacs-commentary-link :tag "Commentary in idlw-shell.el"
"idlw-shell.el")
:link '(emacs-commentary-link :tag "Commentary in idlwave.el" "idlwave.el")
@@ -314,7 +299,7 @@ split then a terminal beep and warning are issued."
expression will not be changed. Note that the indentation of a comment
at the beginning of a line is never changed."
:group 'idlwave-code-formatting
- :type 'string)
+ :type 'regexp)
(defcustom idlwave-begin-line-comment nil
"A comment anchored at the beginning of line.
@@ -596,12 +581,7 @@ like this:
MyMethod <Class1,Class2,Class3>
The value of this variable may be nil to inhibit display, or an integer to
-indicate the maximum number of classes to display.
-
-On XEmacs, a full list of classes will also be placed into a `help-echo'
-property on the completion items, so that the list of classes for the current
-item is displayed in the echo area. If the value of this variable is a
-negative integer, the `help-echo' property will be suppressed."
+indicate the maximum number of classes to display."
:group 'idlwave-completion
:type '(choice (const :tag "Don't show" nil)
(integer :tag "Number of classes shown" 1)))
@@ -1069,7 +1049,6 @@ goto Goto Statements
common-blocks Common Blocks
keyword-parameters Keyword Parameters in routine definitions and calls
system-variables System Variables
-fixme FIXME: Warning in comments (on XEmacs only v. 21.0 and up)
class-arrows Object Arrows with class property"
:group 'idlwave-misc
:type '(set
@@ -1084,7 +1063,6 @@ class-arrows Object Arrows with class property"
(const :tag "Common Blocks" common-blocks)
(const :tag "Keyword Parameters" keyword-parameters)
(const :tag "System Variables" system-variables)
- (const :tag "FIXME: Warning" fixme)
(const :tag "Object Arrows with class property " class-arrows)))
(defcustom idlwave-mode-hook nil
@@ -1096,6 +1074,8 @@ class-arrows Object Arrows with class property"
"Normal hook. Executed when idlwave.el is loaded."
:group 'idlwave-misc
:type 'hook)
+(make-obsolete-variable 'idlwave-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defvar idlwave-experimental nil
"Non-nil means turn on a few experimental features.
@@ -1151,23 +1131,16 @@ As a user, you should not set this to t.")
;; Common blocks
(common-blocks
'("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?"
- (1 font-lock-keyword-face) ; "common"
- (2 font-lock-constant-face nil t) ; block name
+ (1 font-lock-keyword-face) ; "common"
+ (2 font-lock-constant-face nil t) ; block name
("[ \t]*\\(\\sw+\\)[ ,]*"
;; Start with point after block name and comma
- (goto-char (match-end 0)) ; needed for XEmacs, could be nil
- nil
- (1 font-lock-variable-name-face) ; variable names
- )))
+ nil nil (1 font-lock-variable-name-face)))) ; variable names
;; Batch files
(batch-files
'("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face)))
- ;; FIXME warning.
- (fixme
- '("\\<FIXME:" (0 font-lock-warning-face t)))
-
;; Labels
(label
'("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face)))
@@ -1254,9 +1227,6 @@ As a user, you should not set this to t.")
((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w"))
beginning-of-line))
-(put 'idlwave-mode 'font-lock-defaults
- idlwave-font-lock-defaults) ; XEmacs
-
(defconst idlwave-comment-line-start-skip "^[ \t]*;"
"Regexp to match the start of a full-line comment.
That is the _beginning_ of a line containing a comment delimiter `;' preceded
@@ -1492,9 +1462,7 @@ Otherwise ARGS forms a list that is evaluated."
(define-key map "\M-\C-i" 'idlwave-complete)
(define-key map "\C-c\C-i" 'idlwave-update-routine-info)
(define-key map "\C-c=" 'idlwave-resolve)
- (define-key map
- (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)])
- 'idlwave-mouse-context-help)
+ (define-key map [(shift mouse-3)] 'idlwave-mouse-context-help)
map)
"Keymap used in IDL mode.")
@@ -1870,7 +1838,6 @@ The main features of this mode are
8. Hooks
-----
- Loading idlwave.el runs `idlwave-load-hook'.
Turning on `idlwave-mode' runs `idlwave-mode-hook'.
9. Documentation and Customization
@@ -1879,7 +1846,7 @@ The main features of this mode are
\\[idlwave-info] to display (complain to your sysadmin if that does
not work). For Postscript, PDF, and HTML versions of the
documentation, check IDLWAVE's homepage at URL
- `http://github.com/jdtsmith/idlwave'.
+ `https://github.com/jdtsmith/idlwave'.
IDLWAVE has customize support - see the group `idlwave'.
10.Keybindings
@@ -1930,8 +1897,6 @@ The main features of this mode are
(add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS")))
;; Font-lock additions
- ;; Following line is for Emacs - XEmacs uses the corresponding property
- ;; on the `idlwave-mode' symbol.
(set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults)
(set (make-local-variable 'font-lock-mark-block-function)
'idlwave-mark-subprogram)
@@ -2091,11 +2056,7 @@ Returns point if comment found and nil otherwise."
(backward-char 1)
(point)))))
-(defun idlwave-region-active-p ()
- "Should we operate on an active region?"
- (if (fboundp 'use-region-p)
- (use-region-p)
- (region-active-p)))
+(define-obsolete-function-alias 'idlwave-region-active-p 'use-region-p "28.1")
(defun idlwave-show-matching-quote ()
"Insert quote and show matching quote if this is end of a string."
@@ -3832,15 +3793,8 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(setq start (match-end 0)))
(setq ret_string (concat ret_string (substring string start last)))))
-(defun idlwave-get-buffer-visiting (file)
- ;; Return the buffer currently visiting FILE
- (cond
- ((boundp 'find-file-compare-truenames) ; XEmacs
- (let ((find-file-compare-truenames t))
- (get-file-buffer file)))
- ((fboundp 'find-buffer-visiting) ; Emacs
- (find-buffer-visiting file))
- (t (error "This should not happen (idlwave-get-buffer-visiting)"))))
+(define-obsolete-function-alias 'idlwave-get-buffer-visiting
+ #'find-buffer-visiting "28.1")
(defvar idlwave-outlawed-buffers nil
"List of buffers pulled up by IDLWAVE for special reasons.
@@ -3848,7 +3802,7 @@ Buffers in this list may be killed by `idlwave-kill-autoloaded-buffers'.")
(defun idlwave-find-file-noselect (file &optional why)
;; Return a buffer visiting file.
- (or (idlwave-get-buffer-visiting file)
+ (or (find-buffer-visiting file)
(let ((buf (find-file-noselect file)))
(if why (add-to-list 'idlwave-outlawed-buffers (cons buf why)))
buf)))
@@ -6636,7 +6590,6 @@ This function is not general, can only be used for completion stuff."
"A form to evaluate after completion selection in *Completions* buffer.")
(defconst idlwave-completion-mark (make-marker)
"A mark pointing to the beginning of the completion string.")
-(defvar completion-highlight-first-word-only) ;XEmacs.
(defun idlwave-complete-in-buffer (type stype list selector prompt isa
&optional prepare-display-function
@@ -6715,12 +6668,7 @@ accumulate information on matching completions."
list))
(let* ((list all-completions)
;; "complete" means, this is already a valid completion
- (complete (memq spart all-completions))
- (completion-highlight-first-word-only t)) ; XEmacs
- ;; (completion-fixup-function ; Emacs
- ;; (lambda () (and (eq (preceding-char) ?>)
- ;; (re-search-backward " <" beg t)))))
-
+ (complete (memq spart all-completions)))
(setq list (sort list (lambda (a b)
(string< (downcase a) (downcase b)))))
(if prepare-display-function
@@ -6779,10 +6727,8 @@ accumulate information on matching completions."
(not super-classes))) ; no possibilities for inheritance
;; In these cases, we do not have to do anything
list
- (let* ((do-prop (and (>= show-classes 0)
- (>= emacs-major-version 21)))
+ (let* ((do-prop (>= show-classes 0))
(do-buf (not (= show-classes 0)))
- ;; (do-dots (featurep 'xemacs))
(do-dots t)
(inherit (if (and (not (eq type 'class-tag)) super-classes)
(cons class-selector super-classes)))
@@ -6848,10 +6794,6 @@ accumulate information on matching completions."
;;----------------------------------------------------------------------
;;----------------------------------------------------------------------
;;----------------------------------------------------------------------
-(when (featurep 'xemacs)
- (defvar rtn)
- (defun idlwave-pset (item)
- (set 'rtn item)))
(defun idlwave-popup-select (ev list title &optional sort)
"Select an item in LIST with a popup menu.
@@ -6862,17 +6804,6 @@ sort the list before displaying."
(cond ((null list))
((= 1 (length list))
(setq rtn (car list)))
- ((featurep 'xemacs)
- (if sort (setq list (sort list (lambda (a b)
- (string< (upcase a) (upcase b))))))
- (setq menu
- (append (list title)
- (mapcar (lambda (x) (vector x (list 'idlwave-pset
- x)))
- list)))
- (setq menu (idlwave-split-menu-xemacs menu maxpopup))
- (let ((resp (get-popup-menu-response menu)))
- (funcall (event-function resp) (event-object resp))))
(t
(if sort (setq list (sort list (lambda (a b)
(string< (upcase a) (upcase b))))))
@@ -6880,36 +6811,14 @@ sort the list before displaying."
(list
(append (list "")
(mapcar (lambda(x) (cons x x)) list)))))
- (setq menu (idlwave-split-menu-emacs menu maxpopup))
+ (setq menu (idlwave-split-menu menu maxpopup))
(setq rtn (x-popup-menu ev menu))))
rtn))
-(defun idlwave-split-menu-xemacs (menu N)
- "Split the MENU into submenus of maximum length N."
- (if (<= (length menu) (1+ N))
- ;; No splitting needed
- menu
- (let* ((title (car menu))
- (entries (cdr menu))
- (menu (list title))
- (cnt 0)
- (nextmenu nil))
- (while entries
- (while (and entries (< cnt N))
- (setq cnt (1+ cnt)
- nextmenu (cons (car entries) nextmenu)
- entries (cdr entries)))
- (setq nextmenu (nreverse nextmenu))
- (setq nextmenu (cons (format "%s...%s"
- (aref (car nextmenu) 0)
- (aref (nth (1- cnt) nextmenu) 0))
- nextmenu))
- (setq menu (cons nextmenu menu)
- nextmenu nil
- cnt 0))
- (nreverse menu))))
+(define-obsolete-function-alias 'idlwave-split-menu-emacs
+ #'idlwave-split-menu "28.1")
-(defun idlwave-split-menu-emacs (menu N)
+(defun idlwave-split-menu (menu N)
"Split the MENU into submenus of maximum length N."
(if (<= (length (nth 1 menu)) (1+ N))
;; No splitting needed
@@ -6964,10 +6873,7 @@ sort the list before displaying."
(move-marker idlwave-completion-mark beg)
(setq idlwave-before-completion-wconf (current-window-configuration)))
- (if (featurep 'xemacs)
- (idlwave-display-completion-list-xemacs
- list)
- (idlwave-display-completion-list-emacs list))
+ (idlwave-display-completion-list-1 list)
;; Store a special value in `this-command'. When `idlwave-complete'
;; finds this in `last-command', it will scroll the *Completions* buffer.
@@ -7025,8 +6931,7 @@ The key which is associated with each option is generated automatically.
First, the strings are checked for preselected keys, like in \"[P]rint\".
If these don't exist, a letter in the string is automatically selected."
(let* ((alist (symbol-value sym))
- (temp-buffer-show-hook (if (fboundp 'fit-window-to-buffer)
- '(fit-window-to-buffer)))
+ (temp-buffer-show-hook '(fit-window-to-buffer))
keys-alist char)
;; First check the cache
(if (and (eq (symbol-value sym) (get sym :one-key-alist-last)))
@@ -7112,42 +7017,17 @@ If these don't exist, a letter in the string is automatically selected."
(and (local-variable-p var (current-buffer))
(symbol-value var))))
-;; In XEmacs, we can use :activate-callback directly to advice the
-;; choose functions. We use the private keymap only for the online
-;; help feature.
-
(defvar idlwave-completion-map nil
"Keymap for `completion-list-mode' with `idlwave-complete'.")
-(defun idlwave-display-completion-list-xemacs (list &rest cl-args)
- (with-output-to-temp-buffer "*Completions*"
- (apply 'display-completion-list list
- ':activate-callback 'idlwave-default-choose-completion
- cl-args))
- (with-current-buffer "*Completions*"
- (use-local-map
- (or idlwave-completion-map
- (setq idlwave-completion-map
- (idlwave-make-modified-completion-map-xemacs
- (current-local-map)))))))
-
(defun idlwave-default-choose-completion (&rest args)
"Execute `default-choose-completion' and then restore the win-conf."
(apply 'idlwave-choose 'default-choose-completion args))
-(defun idlwave-make-modified-completion-map-xemacs (old-map)
- "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP."
- (let ((new-map (copy-keymap old-map)))
- (define-key new-map [button3up] 'idlwave-mouse-completion-help)
- (define-key new-map [button3] (lambda ()
- (interactive)
- (setq this-command last-command)))
- new-map))
-
-;; In Emacs we also replace keybindings in the completion
-;; map in order to install our wrappers.
+(define-obsolete-function-alias 'idlwave-display-completion-list-emacs
+ #'idlwave-display-completion-list-1 "28.1")
-(defun idlwave-display-completion-list-emacs (list)
+(defun idlwave-display-completion-list-1 (list)
"Display completion list and install the choose wrappers."
(with-output-to-temp-buffer "*Completions*"
(display-completion-list list))
@@ -7155,16 +7035,16 @@ If these don't exist, a letter in the string is automatically selected."
(use-local-map
(or idlwave-completion-map
(setq idlwave-completion-map
- (idlwave-make-modified-completion-map-emacs
- (current-local-map)))))))
+ (idlwave-make-modified-completion-map (current-local-map)))))))
+
+(define-obsolete-function-alias 'idlwave-make-modified-completion-map-emacs
+ #'idlwave-make-modified-completion-map "28.1")
-(defun idlwave-make-modified-completion-map-emacs (old-map)
- "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP."
+(defun idlwave-make-modified-completion-map (old-map)
+ "Replace `choose-completion' in OLD-MAP."
(let ((new-map (copy-keymap old-map)))
(substitute-key-definition
'choose-completion 'idlwave-choose-completion new-map)
- (substitute-key-definition
- 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map)
(define-key new-map [mouse-3] 'idlwave-mouse-completion-help)
new-map))
@@ -7173,10 +7053,8 @@ If these don't exist, a letter in the string is automatically selected."
(interactive (list last-nonmenu-event))
(apply 'idlwave-choose 'choose-completion args))
-(defun idlwave-mouse-choose-completion (&rest args)
- "Click on an alternative in the `*Completions*' buffer to choose it."
- (interactive "e")
- (apply 'idlwave-choose 'mouse-choose-completion args))
+(define-obsolete-function-alias 'idlwave-mouse-choose-completion
+ #'idlwave-choose-completion "28.1")
;;----------------------------------------------------------------------
;;----------------------------------------------------------------------
@@ -7370,7 +7248,7 @@ class/struct definition."
(file (idlwave-routine-source-file
(nth 3 (idlwave-rinfo-assoc pro 'pro nil
(idlwave-routines))))))
- (cons file (if file (idlwave-get-buffer-visiting file)))))
+ (cons file (if file (find-buffer-visiting file)))))
(defun idlwave-scan-class-info (class)
@@ -8241,15 +8119,9 @@ If we do not know about MODULE, just return KEYWORD literally."
(defvar idlwave-rinfo-mouse-map
(let ((map (make-sparse-keymap)))
- (define-key map
- (if (featurep 'xemacs) [button2] [mouse-2])
- 'idlwave-mouse-active-rinfo)
- (define-key map
- (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])
- 'idlwave-mouse-active-rinfo-shift)
- (define-key map
- (if (featurep 'xemacs) [button3] [mouse-3])
- 'idlwave-mouse-active-rinfo-right)
+ (define-key map [mouse-2] 'idlwave-mouse-active-rinfo)
+ (define-key map [(shift mouse-2)] 'idlwave-mouse-active-rinfo-shift)
+ (define-key map [mouse-3] 'idlwave-mouse-active-rinfo-right)
(define-key map " " 'idlwave-active-rinfo-space)
(define-key map "q" 'idlwave-quit-help)
map))
@@ -8301,7 +8173,6 @@ If we do not know about MODULE, just return KEYWORD literally."
"Button2: Display info about same method in superclass")
(col 0)
(data (list name type class (current-buffer) nil initial-class))
- (km-prop (if (featurep 'xemacs) 'keymap 'local-map))
(face 'idlwave-help-link)
beg props win cnt total)
;; Fix keywords, but don't add chained super-classes, since these
@@ -8326,7 +8197,7 @@ If we do not know about MODULE, just return KEYWORD literally."
idlwave-current-obj_new-class)
(when superclasses
(setq props (list 'mouse-face 'highlight
- km-prop idlwave-rinfo-mouse-map
+ 'local-map idlwave-rinfo-mouse-map
'help-echo help-echo-class
'data (cons 'class data)))
(let ((classes (cons initial-class superclasses)) c)
@@ -8342,7 +8213,7 @@ If we do not know about MODULE, just return KEYWORD literally."
(add-text-properties beg (point) props))))
(insert "\n")))
(setq props (list 'mouse-face 'highlight
- km-prop idlwave-rinfo-mouse-map
+ 'local-map idlwave-rinfo-mouse-map
'help-echo help-echo-use
'data (cons 'usage data)))
(if html-file (setq props (append (list 'face face 'link html-file)
@@ -8370,7 +8241,7 @@ If we do not know about MODULE, just return KEYWORD literally."
(setq beg (point)
;; Relevant keywords already have link property attached
props (list 'mouse-face 'highlight
- km-prop idlwave-rinfo-mouse-map
+ 'local-map idlwave-rinfo-mouse-map
'data (cons 'keyword data)
'help-echo help-echo-kwd
'keyword (car x)))
@@ -8384,7 +8255,7 @@ If we do not know about MODULE, just return KEYWORD literally."
;; Here entry is (key file (list of type-conses))
(while (setq entry (pop all))
(setq props (list 'mouse-face 'highlight
- km-prop idlwave-rinfo-mouse-map
+ 'local-map idlwave-rinfo-mouse-map
'help-echo help-echo-src
'source (list (car (car (nth 2 entry))) ;type
(nth 1 entry)
@@ -8489,8 +8360,7 @@ to it."
(add-text-properties beg (point) (list 'face 'bold)))
(when (and file (not (equal file "")))
(setq beg (point))
- (insert (apply 'abbreviate-file-name
- (if (featurep 'xemacs) (list file t) (list file))))
+ (insert (apply 'abbreviate-file-name (list file)))
(if file-props
(add-text-properties beg (point) file-props)))))
@@ -8650,10 +8520,9 @@ can be used to detect possible name clashes during this process."
idlwave-user-catalog-routines
idlwave-buffer-routines
nil))
- (km-prop (if (featurep 'xemacs) 'keymap 'local-map))
(keymap (make-sparse-keymap))
(props (list 'mouse-face 'highlight
- km-prop keymap
+ 'local-map keymap
'help-echo "Mouse2: Find source"))
(nroutines (length (or special-routines routines)))
(step (/ nroutines 100))
@@ -8676,7 +8545,7 @@ can be used to detect possible name clashes during this process."
(nth 2 b) (car b)))))))
(message "Sorting routines...done")
- (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)])
+ (define-key keymap [(mouse-2)]
(lambda (ev)
(interactive "e")
(mouse-set-point ev)
@@ -9038,23 +8907,6 @@ Assumes that point is at the beginning of the unit as found by
'imenu)
(error nil)))))
-;; Here we hack func-menu.el in order to support this new mode.
-;; The latest versions of func-menu.el already have this stuff in, so
-;; we hack only if it is not already there.
-(when (featurep 'xemacs)
- (eval-after-load "func-menu"
- '(progn
- (or (assq 'idlwave-mode fume-function-name-regexp-alist)
- (not (boundp 'fume-function-name-regexp-idl)) ; avoid problems
- (setq fume-function-name-regexp-alist
- (cons '(idlwave-mode . fume-function-name-regexp-idl)
- fume-function-name-regexp-alist)))
- (or (assq 'idlwave-mode fume-find-function-name-method-alist)
- (not (fboundp 'fume-find-next-idl-function-name)) ; avoid problems
- (setq fume-find-function-name-method-alist
- (cons '(idlwave-mode . fume-find-next-idl-function-name)
- fume-find-function-name-method-alist))))))
-
(defun idlwave-edit-in-idlde ()
"Edit the current file in IDL Development environment."
(interactive)
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index a24b94073fc..59db646ff32 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -130,9 +130,8 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
;;; "This function binds many inferior-lisp commands to C-c <letter> bindings,
;;;where they are more accessible. C-c <letter> bindings are reserved for the
-;;;user, so these bindings are non-standard. If you want them, you should
-;;;have this function called by the inferior-lisp-load-hook:
-;;; (add-hook 'inferior-lisp-load-hook 'inferior-lisp-install-letter-bindings)
+;;;user, so these bindings are non-standard. If you want them:
+;;; (with-eval-after-load 'inf-lisp 'inferior-lisp-install-letter-bindings)
;;;You can modify this function to install just the bindings you want."
(defun inferior-lisp-install-letter-bindings ()
(define-key lisp-mode-map "\C-ce" 'lisp-eval-defun-and-go)
@@ -555,10 +554,7 @@ Used by these commands to determine defaults."
;;; Reads a string from the user.
(defun lisp-symprompt (prompt default)
- (list (let* ((prompt (if default
- (format "%s (default %s): " prompt default)
- (concat prompt ": ")))
- (ans (read-string prompt)))
+ (list (let ((ans (read-string (format-prompt prompt default))))
(if (zerop (length ans)) default ans))))
@@ -632,6 +628,8 @@ See variable `lisp-describe-sym-command'."
;;;===============================
(defvar inferior-lisp-load-hook nil
"This hook is run when the library `inf-lisp' is loaded.")
+(make-obsolete-variable 'inferior-lisp-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'inferior-lisp-load-hook)
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 5ec3e942753..f3cfbbb948f 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -4570,7 +4570,7 @@ This function is intended for use in `after-change-functions'."
;; Comments
(setq-local comment-start "// ")
- (setq-local comment-start-skip "\\(//+\\|/\\*+\\)\\s *")
+ (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *")
(setq-local comment-end "")
(setq-local fill-paragraph-function #'js-fill-paragraph)
(setq-local normal-auto-fill-function #'js-do-auto-fill)
@@ -4591,7 +4591,8 @@ This function is intended for use in `after-change-functions'."
(setq imenu-create-index-function #'js--imenu-create-index)
;; for filling, pretend we're cc-mode
- (c-init-language-vars js-mode)
+ (c-foreign-init-lit-pos-cache)
+ (add-hook 'before-change-functions #'c-foreign-truncate-lit-pos-cache nil t)
(setq-local comment-line-break-function #'c-indent-new-comment-line)
(setq-local comment-multi-line t)
(setq-local electric-indent-chars
@@ -4655,8 +4656,19 @@ could set `js-jsx-syntax' to t in your init file, or in a
one of the aforementioned options instead of using this mode."
:group 'js
(js-jsx-enable)
+ (setq-local comment-region-function #'js-jsx--comment-region)
(js-use-syntactic-mode-name))
+(defun js-jsx--comment-region (beg end &optional arg)
+ (if (or (js-jsx--context)
+ (save-excursion
+ (skip-chars-forward " \t")
+ (js-jsx--looking-at-start-tag-p)))
+ (let ((comment-start "{/* ")
+ (comment-end " */}"))
+ (comment-region-default beg end arg))
+ (comment-region-default beg end arg)))
+
;;;###autoload (defalias 'javascript-mode 'js-mode)
(eval-after-load 'folding
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index 442c2309777..b17f255ba6a 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -1,4 +1,4 @@
-;;; ld-script.el --- GNU linker script editing mode for Emacs
+;;; ld-script.el --- GNU linker script editing mode for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el
index 95fead9b374..ec0f425de92 100644
--- a/lisp/progmodes/m4-mode.el
+++ b/lisp/progmodes/m4-mode.el
@@ -1,4 +1,4 @@
-;;; m4-mode.el --- m4 code editing commands for Emacs
+;;; m4-mode.el --- m4 code editing commands for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc.
@@ -48,14 +48,12 @@
"File name of the m4 executable.
If m4 is not in your PATH, set this to an absolute file name."
:version "24.4"
- :type 'file
- :group 'm4)
+ :type 'file)
;;options to m4
(defcustom m4-program-options nil
"Options to pass to `m4-program'."
- :type '(repeat string)
- :group 'm4)
+ :type '(repeat string))
;;to use --prefix-builtins, you can use
;;(defconst m4-program-options '("-P"))
@@ -72,8 +70,7 @@ If m4 is not in your PATH, set this to an absolute file name."
(defcustom m4-mode-hook nil
"Hook called by `m4-mode'."
- :type 'hook
- :group 'm4)
+ :type 'hook)
;;this may still need some work
(defvar m4-mode-syntax-table
@@ -125,7 +122,7 @@ If m4 is not in your PATH, set this to an absolute file name."
(interactive)
(shell-command-on-region
(point-min) (point-max)
- (mapconcat 'identity (cons m4-program m4-program-options) "\s")
+ (mapconcat #'identity (cons m4-program m4-program-options) "\s")
"*m4-output*" nil)
(switch-to-buffer-other-window "*m4-output*"))
@@ -134,7 +131,7 @@ If m4 is not in your PATH, set this to an absolute file name."
(interactive)
(shell-command-on-region
(point) (mark)
- (mapconcat 'identity (cons m4-program m4-program-options) "\s")
+ (mapconcat #'identity (cons m4-program m4-program-options) "\s")
"*m4-output*" nil)
(switch-to-buffer-other-window "*m4-output*"))
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index ec246d63ac2..8596d78a604 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -316,7 +316,7 @@ not be enclosed in { } or ( )."
(defconst makefile-gmake-statements
`("-sinclude" "sinclude" ; makefile-makepp-statements takes rest
"ifdef" "ifndef" "ifeq" "ifneq" "-include" "define" "endef" "export"
- "override define" "override" "unexport" "vpath"
+ "override define" "override" "unexport" "vpath" "undefine"
,@(cdr makefile-automake-statements))
"List of keywords understood by gmake.")
@@ -1413,7 +1413,7 @@ Fill comments, backslashed lines, and variable definitions specially."
"Leave the browser and return to the makefile buffer."
(interactive)
(let ((my-client makefile-browser-client))
- (setq makefile-browser-client nil) ; we quitted, so NO client!
+ (setq makefile-browser-client nil) ; we quit, so NO client!
(set-buffer-modified-p nil)
(quit-window t)
(pop-to-buffer my-client)))
@@ -1600,20 +1600,19 @@ Checks each target in TARGET-TABLE using
and generates the overview, one line per target name."
(insert
(mapconcat
- (function (lambda (item)
- (let* ((target-name (car item))
- (no-prereqs (not (member target-name prereq-list)))
- (needs-rebuild (or no-prereqs
- (funcall
- makefile-query-one-target-method-function
- target-name
- filename))))
- (format "\t%s%s"
- target-name
- (cond (no-prereqs " .. has no prerequisites")
- (needs-rebuild " .. NEEDS REBUILD")
- (t " .. is up to date"))))
- ))
+ (lambda (item)
+ (let* ((target-name (car item))
+ (no-prereqs (not (member target-name prereq-list)))
+ (needs-rebuild (or no-prereqs
+ (funcall
+ makefile-query-one-target-method-function
+ target-name
+ filename))))
+ (format "\t%s%s"
+ target-name
+ (cond (no-prereqs " .. has no prerequisites")
+ (needs-rebuild " .. NEEDS REBUILD")
+ (t " .. is up to date")))))
target-table "\n"))
(goto-char (point-min))
(delete-file filename)) ; remove the tmpfile
@@ -1687,9 +1686,9 @@ Then prompts for all required parameters."
(defun makefile-prompt-for-gmake-funargs (function-name prompt-list)
(mapconcat
- (function (lambda (one-prompt)
- (read-string (format "[%s] %s: " function-name one-prompt)
- nil)))
+ (lambda (one-prompt)
+ (read-string (format "[%s] %s: " function-name one-prompt)
+ nil))
prompt-list
","))
@@ -1721,7 +1720,9 @@ matched in a rule action."
(while (progn (skip-chars-forward makefile-dependency-skip bound)
(< (point) (or bound (point-max))))
(forward-char)
- (or (eq (char-after) ?=)
+ ;; The GNU immediate assignment operator is ":=", while the
+ ;; POSIX operator is "::=".
+ (or (looking-at ":?=")
(get-text-property (1- (point)) 'face)
(if (> (line-beginning-position) (+ (point-min) 2))
(eq (char-before (line-end-position 0)) ?\\))
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index 6f0e535def8..4a5d872b790 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -895,6 +895,8 @@ The environment marked is the one that contains point or follows point."
"Hook evaluated when first loading Metafont or MetaPost mode."
:type 'hook
:group 'meta-font)
+(make-obsolete-variable 'meta-mode-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom meta-common-mode-hook nil
"Hook evaluated by both `metafont-mode' and `metapost-mode'."
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index 468c116b674..b9f60598f63 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -1,11 +1,11 @@
-;;; mixal-mode.el --- Major mode for the mix asm language.
+;;; mixal-mode.el --- Major mode for the mix asm language. -*- lexical-binding:t -*-
;; Copyright (C) 2003-2020 Free Software Foundation, Inc.
;; Author: Pieter E.J. Pareit <pieter.pareit@gmail.com>
-;; Maintainer: emacs-devel@gnu.org
+;; Maintainer: Jose A Ortega Ruiz <jao@gnu.org>
;; Created: 09 Nov 2002
-;; Version: 0.1
+;; Version: 0.4
;; Keywords: languages, Knuth, mix, mixal, asm, mixvm, The Art Of Computer Programming
;; This file is part of GNU Emacs.
@@ -24,6 +24,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
+
;; Major mode for the mix asm language.
;; The mix asm language is described in "The Art Of Computer Programming".
;;
@@ -34,8 +35,9 @@
;;
;; To use this mode, place the following in your init file:
;; `(load-file "/PATH-TO-FILE/mixal-mode.el")'.
+;;
;; When you load a file with the extension .mixal the mode will be started
-;; automatic. If you want to start the mode manual, use `M-x mixal-mode'.
+;; automatically. If you want to start the mode manually, use `M-x mixal-mode'.
;; Font locking will work, the behavior of tabs is the same as Emacs's
;; default behavior. You can compile a source file with `C-c c' you can
;; run a compiled file with `C-c r' or run it in debug mode with `C-c d'.
@@ -45,6 +47,9 @@
;; Have fun.
;;; History:
+;; Version 0.4:
+;; 16/10/20: Jose A Ortega Ruiz <jao@gnu.org>
+;; Add missed instructions: SLB,SRB,JAE,JAO,JXE,JXO
;; Version 0.3:
;; 12/10/05: Stefan Monnier <monnier@iro.umontreal.ca>
;; Use font-lock-syntactic-keywords to detect/mark comments.
@@ -683,6 +688,18 @@ Register J is set to the value of the next instruction that would have
been executed when there was no jump."
1)
+ (JAE jump "jump A even" 40
+ "Jump if the content of rA is even.
+Register J is set to the value of the next instruction that would have
+been executed when there was no jump."
+ 1)
+
+ (JAO jump "jump A odd" 40
+ "Jump if the content of rA is odd.
+Register J is set to the value of the next instruction that would have
+been executed when there was no jump."
+ 1)
+
(JXN jump "jump X negative" 47
"Jump if the content of rX is negative.
Register J is set to the value of the next instruction that would have
@@ -719,12 +736,24 @@ Register J is set to the value of the next instruction that would have
been executed when there was no jump."
1)
- (J1N jump "jump I1 negative" 41
- "Jump if the content of rI1 is negative.
+ (JXE jump "jump X even" 47
+ "Jump if the content of rX is even.
+Register J is set to the value of the next instruction that would have
+been executed when there was no jump."
+ 1)
+
+ (JXO jump "jump X odd" 47
+ "Jump if the content of rX is odd.
Register J is set to the value of the next instruction that would have
been executed when there was no jump."
1)
+ (J1N jump "jump I1 negative" 41
+ "Jump if the content of rI1 is negative.
+Register J is set to the value of the next instruction that would have
+been executed when there was no jump."
+ 1)
+
(J1Z jump "jump I1 zero" 41
"Jump if the content of rI1 is zero.
Register J is set to the value of the next instruction that would have
@@ -950,7 +979,6 @@ Zeros will be added to the left."
Zeros will be added to the right."
2)
-
(SRAX miscellaneous "shift right AX" 6
"Shift AX, M bytes right.
Zeros will be added to the left."
@@ -966,6 +994,14 @@ The bytes that fall off to the left will be added to the right."
The bytes that fall off to the right will be added to the left."
2)
+ (SLB miscellaneous "shift left AX binary" 6
+ "Shift AX, M binary places left."
+ 2)
+
+ (SRB miscellaneous "shift right AX binary" 6
+ "Shift AX, M binary places right."
+ 2)
+
(MOVE miscellaneous "move" 7 number
"Move MOD words from M to the location stored in rI1."
(+ 1 (* 2 number)))
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index 9e039562549..55a78c6cc85 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -165,7 +165,7 @@ parenthetical grouping.")
(modify-syntax-entry ?| "." table)
(modify-syntax-entry ?! "." table)
(modify-syntax-entry ?\\ "." table)
- (modify-syntax-entry ?\' "." table)
+ (modify-syntax-entry ?\' "\"" table)
(modify-syntax-entry ?\` "." table)
(modify-syntax-entry ?. "." table)
(modify-syntax-entry ?\" "\"" table)
@@ -619,8 +619,7 @@ Key bindings:
(add-hook 'before-save-hook 'octave-sync-function-file-names nil t)
(setq-local beginning-of-defun-function 'octave-beginning-of-defun)
(and octave-font-lock-texinfo-comment (octave-font-lock-texinfo-comment))
- (add-function :before-until (local 'eldoc-documentation-function)
- 'octave-eldoc-function)
+ (add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t)
(easy-menu-add octave-mode-menu))
@@ -756,7 +755,7 @@ Key bindings:
(setq font-lock-defaults '(inferior-octave-font-lock-keywords nil nil))
(setq-local info-lookup-mode 'octave-mode)
- (setq-local eldoc-documentation-function 'octave-eldoc-function)
+ (add-hook 'eldoc-documentation-functions 'octave-eldoc-function nil t)
(setq-local comint-input-ring-file-name
(or (getenv "OCTAVE_HISTFILE") "~/.octave_hist"))
@@ -1049,10 +1048,9 @@ directory and makes this the current buffer's default directory."
(save-excursion
(skip-syntax-backward "-(")
(thing-at-point 'symbol)))))
- (completing-read
- (format (if def "Function (default %s): " "Function: ") def)
- (inferior-octave-completion-table)
- nil nil nil nil def)))
+ (completing-read (format-prompt "Function" def)
+ (inferior-octave-completion-table)
+ nil nil nil nil def)))
(defun octave-goto-function-definition (fn)
"Go to the function definition of FN in current buffer."
@@ -1173,10 +1171,7 @@ q: Don't fix\n" func file))
(min (line-end-position 4) end)
t)
(match-string 1))))
- (old-func (read-string (format (if old-func
- "Name to replace (default %s): "
- "Name to replace: ")
- old-func)
+ (old-func (read-string (format-prompt "Name to replace" old-func)
nil nil old-func)))
(if (and func old-func (not (equal func old-func)))
(perform-replace old-func func 'query
@@ -1455,7 +1450,7 @@ The block marked is the one that contains point or follows point."
Prompt for the function's name, arguments and return values (to be
entered without parens)."
(let* ((defname (file-name-sans-extension (buffer-name)))
- (name (read-string (format "Function name (default %s): " defname)
+ (name (read-string (format-prompt "Function name" defname)
nil nil defname))
(args (read-string "Arguments: "))
(vals (read-string "Return values: ")))
@@ -1640,8 +1635,8 @@ code line."
(nreverse result)))))
(cdr octave-eldoc-cache))
-(defun octave-eldoc-function ()
- "A function for `eldoc-documentation-function' (which see)."
+(defun octave-eldoc-function (&rest _ignored)
+ "A function for `eldoc-documentation-functions' (which see)."
(when (inferior-octave-process-live-p)
(let* ((ppss (syntax-ppss))
(paren-pos (cadr ppss))
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el
index fcd9294f660..8c060991f42 100644
--- a/lisp/progmodes/opascal.el
+++ b/lisp/progmodes/opascal.el
@@ -1688,7 +1688,7 @@ comment block. If not in a // comment, just does a normal newline."
;; as comment starters. Fix it here by removing the "2" from the syntax
;; of the second char of such sequences.
("/\\(\\*\\)" (1 ". 3b"))
- ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil)))
+ ("(\\(/\\)" (1 (prog1 ". 1c" (forward-char -1) nil)))
;; Pascal uses '' and "" rather than \' and \" to escape quotes.
("''\\|\"\"" (0 (if (save-excursion
(nth 3 (syntax-ppss (match-beginning 0))))
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index 13505d04a2d..fce059bafc7 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -187,7 +187,7 @@
;; as comment starters. Fix it here by removing the "2" from the syntax
;; of the second char of such sequences.
("/\\(\\*\\)" (1 ". 3b"))
- ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil)))
+ ("(\\(/\\)" (1 (prog1 ". 1c" (forward-char -1) nil)))
;; Pascal uses '' and "" rather than \' and \" to escape quotes.
("''\\|\"\"" (0 (if (save-excursion
(nth 3 (syntax-ppss (match-beginning 0))))
@@ -589,7 +589,7 @@ See also `pascal-comment-area'."
(interactive)
(catch 'found
(if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re)))
- (forward-sexp 1))
+ (ignore-errors (forward-sexp 1)))
(let ((nest 0) (max -1) (func 0)
(reg (concat pascal-beg-block-re "\\|"
pascal-end-block-re "\\|"
@@ -1170,26 +1170,27 @@ indent of the current line in parameterlist."
(defun pascal-type-completion (pascal-str)
"Calculate all possible completions for types."
- (let ((start (point))
- (pascal-all ())
- goon)
- ;; Search for all reachable type declarations
- (while (or (pascal-beg-of-defun)
- (setq goon (not goon)))
- (save-excursion
- (if (and (< start (prog1 (save-excursion (pascal-end-of-defun)
- (point))
- (forward-char 1)))
- (re-search-forward
- "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>"
- start t)
- (not (match-end 1)))
- ;; Check current type declaration
- (setq pascal-all
- (nconc (pascal-get-completion-decl pascal-str)
- pascal-all)))))
+ (save-excursion
+ (let ((start (point))
+ (pascal-all ())
+ goon)
+ ;; Search for all reachable type declarations
+ (while (or (pascal-beg-of-defun)
+ (setq goon (not goon)))
+ (save-excursion
+ (if (and (< start (prog1 (save-excursion (pascal-end-of-defun)
+ (point))
+ (forward-char 1)))
+ (re-search-forward
+ "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>"
+ start t)
+ (not (match-end 1)))
+ ;; Check current type declaration
+ (setq pascal-all
+ (nconc (pascal-get-completion-decl pascal-str)
+ pascal-all)))))
- pascal-all))
+ pascal-all)))
(defun pascal-var-completion (prefix)
"Calculate all possible completions for variables (or constants)."
@@ -1263,11 +1264,13 @@ indent of the current line in parameterlist."
(and (eq state 'defun)
(save-excursion
(re-search-backward ")[ \t]*:" (point-at-bol) t))))
- (if (or (eq state 'paramlist) (eq state 'defun))
- (pascal-beg-of-defun))
- (nconc
- (pascal-type-completion pascal-str)
- (pascal-keyword-completion pascal-type-keywords pascal-str)))
+ (save-excursion
+ (if (or (eq state 'paramlist) (eq state 'defun))
+ (pascal-beg-of-defun))
+ (nconc
+ (pascal-type-completion pascal-str)
+ (pascal-keyword-completion pascal-type-keywords
+ pascal-str))))
( ;--Starting a new statement
(and (not (eq state 'contexp))
(save-excursion
@@ -1392,7 +1395,7 @@ The default is a name found in the buffer around point."
(defvar pascal-outline-map
(let ((map (make-sparse-keymap)))
(if (fboundp 'set-keymap-name)
- (set-keymap-name pascal-outline-map 'pascal-outline-map))
+ (set-keymap-name map 'pascal-outline-map))
(define-key map "\M-\C-a" 'pascal-outline-prev-defun)
(define-key map "\M-\C-e" 'pascal-outline-next-defun)
(define-key map "\C-c\C-d" 'pascal-outline-goto-defun)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f864f6a34cd..7265aeee45d 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -214,7 +214,9 @@
(defconst perl--syntax-exp-intro-regexp
(concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
(regexp-opt perl--syntax-exp-intro-keywords)
- "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*")))
+ "\\|[?:.,;|&*=!~({[]"
+ "\\|[^-+][-+]" ;Bug#42168: `+' is intro but `++' isn't!
+ "\\|\\(^\\)\\)[ \t\n]*")))
(defun perl-syntax-propertize-function (start end)
(let ((case-fold-search nil))
@@ -235,7 +237,7 @@
(match-beginning 0))))))
(string-to-syntax ". p"))))
;; Handle funny names like $DB'stop.
- ("\\$ ?{?^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
+ ("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
;; format statements
("^[ \t]*format.*=[ \t]*\\(\n\\)"
(1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
@@ -256,7 +258,7 @@
;; (or some similar separator), or by one of the special keywords
;; corresponding to builtin functions that can take their first arg
;; without parentheses. Of course, that presume we're looking at the
- ;; *opening* slash. We can afford to mis-match the closing ones
+ ;; *opening* slash. We can afford to mismatch the closing ones
;; here, because they will be re-treated separately later in
;; perl-font-lock-special-syntactic-constructs.
((concat perl--syntax-exp-intro-regexp "\\(/\\)")
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index f5f4092babf..a395453491b 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,6 +1,11 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Version: 0.5.2
+;; Package-Requires: ((emacs "26.3") (xref "1.0.2"))
+
+;; This is a GNU ELPA :core package. Avoid using functionality that
+;; not compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -19,6 +24,11 @@
;;; Commentary:
+;; NOTE: The project API is still experimental and can change in major,
+;; backward-incompatible ways. Everyone is encouraged to try it, and
+;; report to us any problems or use cases we hadn't anticipated, by
+;; sending an email to emacs-devel, or `M-x report-emacs-bug'.
+;;
;; This file contains generic infrastructure for dealing with
;; projects, some utility functions, and commands using that
;; infrastructure.
@@ -27,27 +37,83 @@
;; current project, without having to know which package handles
;; detection of that project type, parsing its config files, etc.
;;
-;; NOTE: The project API is still experimental and can change in major,
-;; backward-incompatible ways. Everyone is encouraged to try it, and
-;; report to us any problems or use cases we hadn't anticipated, by
-;; sending an email to emacs-devel, or `M-x report-emacs-bug'.
+;; This file consists of following parts:
+;;
+;; Infrastructure (the public API):
+;;
+;; Function `project-current' that returns the current project
+;; instance based on the value of the hook `project-find-functions',
+;; and several generic functions that act on it.
+;;
+;; `project-root' must be defined for every project.
+;; `project-files' can be overridden for performance purposes.
+;; `project-ignores' and `project-external-roots' describe the project
+;; files and its relations to external directories. `project-files'
+;; should be consistent with `project-ignores'.
;;
-;; Infrastructure:
+;; This list can change in future versions.
;;
-;; Function `project-current', to determine the current project
-;; instance, and 5 (at the moment) generic functions that act on it.
-;; This list is to be extended in future versions.
+;; VC project:
+;;
+;; Originally conceived as an example implementation, now it's a
+;; relatively fast backend that delegates to 'git ls-files' or 'hg
+;; status' to list the project's files. It honors the VC ignore
+;; files, but supports additions to the list using the user option
+;; `project-vc-ignores' (usually through .dir-locals.el).
;;
;; Utils:
;;
;; `project-combine-directories' and `project-subtract-directories',
;; mainly for use in the abovementioned generics' implementations.
;;
+;; `project-known-project-roots' and `project-remember-project' to
+;; interact with the "known projects" list.
+;;
;; Commands:
;;
-;; `project-find-file', `project-find-regexp' and
-;; `project-or-external-find-regexp' use the current API, and thus
-;; will work in any project that has an adapter.
+;; `project-prefix-map' contains the full list of commands defined in
+;; this package. This map uses the prefix `C-x p' by default.
+;; Type `C-x p f' to find file in the current project.
+;; Type `C-x p C-h' to see all available commands and bindings.
+;;
+;; All commands defined in this package are implemented using the
+;; public API only. As a result, they will work with any project
+;; backend that follows the protocol.
+;;
+;; Any third-party code that wants to use this package should likewise
+;; target the public API. Use any of the built-in commands as the
+;; example.
+;;
+;; How to create a new backend:
+;;
+;; - Consider whether you really should, or whether there are other
+;; ways to reach your goals. If the backend's performance is
+;; significantly lower than that of the built-in one, and it's first
+;; in the list, it will affect all commands that use it. Unless you
+;; are going to be using it only yourself or in special circumstances,
+;; you will probably want it to be fast, and it's unlikely to be a
+;; trivial endeavor. `project-files' is the method to optimize (the
+;; default implementation gets slower the more files the directory
+;; has, and the longer the list of ignores is).
+;;
+;; - Choose the format of the value that represents a project for your
+;; backend (we call it project instance). Don't use any of the
+;; formats from other backends. The format can be arbitrary, as long
+;; as the datatype is something `cl-defmethod' can dispatch on. The
+;; value should be stable (when compared with `equal') across
+;; invocations, meaning calls to that function from buffers belonging
+;; to the same project should return equal values.
+;;
+;; - Write a new function that will determine the current project
+;; based on the directory and add it to `project-find-functions'
+;; (which see) using `add-hook'. It is a good idea to depend on the
+;; directory only, and not on the current major mode, for example.
+;; Because the usual expectation is that all files in the directory
+;; belong to the same project (even if some/most of them are ignored).
+;;
+;; - Define new methods for some or all generic functions for this
+;; backend using `cl-defmethod'. A `project-root' method is
+;; mandatory, `project-files' is recommended, the rest are optional.
;;; TODO:
@@ -72,9 +138,7 @@
;; whole Emacs session, independent of the current directory. Or,
;; in the more advanced case, open a set of projects, and have some
;; project-related commands to use them all. E.g., have a command
-;; to search for a regexp across all open projects. Provide a
-;; history of projects that were opened in the past (storing it as a
-;; list of directories should suffice).
+;; to search for a regexp across all open projects.
;;
;; * Support for project-local variables: a UI to edit them, and a
;; utility function to retrieve a value. Probably useless without
@@ -88,43 +152,81 @@
;;; Code:
(require 'cl-generic)
+(require 'seq)
+(eval-when-compile (require 'subr-x))
+
+(defgroup project nil
+ "Operations on the current project."
+ :version "28.1"
+ :group 'tools)
(defvar project-find-functions (list #'project-try-vc)
"Special hook to find the project containing a given directory.
Each functions on this hook is called in turn with one
-argument (the directory) and should return either nil to mean
-that it is not applicable, or a project instance.")
+argument, the directory in which to look, and should return
+either nil to mean that it is not applicable, or a project instance.
+The exact form of the project instance is up to each respective
+function; the only practical limitation is to use values that
+`cl-defmethod' can dispatch on, like a cons cell, or a list, or a
+CL struct.")
+
+(defvar project-current-inhibit-prompt nil
+ "Non-nil to skip prompting the user in `project-current'.")
;;;###autoload
-(defun project-current (&optional maybe-prompt dir)
- "Return the project instance in DIR or `default-directory'.
-When no project found in DIR, and MAYBE-PROMPT is non-nil, ask
-the user for a different directory to look in. If that directory
-is not a part of a detectable project either, return a
-`transient' project instance rooted in it."
- (unless dir (setq dir default-directory))
- (let ((pr (project--find-in-directory dir)))
+(defun project-current (&optional maybe-prompt directory)
+ "Return the project instance in DIRECTORY, defaulting to `default-directory'.
+
+When no project is found in that directory, the result depends on
+the value of MAYBE-PROMPT: if it is nil or omitted, return nil,
+else ask the user for a directory in which to look for the
+project, and if no project is found there, return a \"transient\"
+project instance.
+
+The \"transient\" project instance is a special kind of value
+which denotes a project rooted in that directory and includes all
+the files under the directory except for those that should be
+ignored (per `project-ignores').
+
+See the doc string of `project-find-functions' for the general form
+of the project instance object."
+ (unless directory (setq directory default-directory))
+ (let ((pr (project--find-in-directory directory)))
(cond
(pr)
- (maybe-prompt
- (setq dir (read-directory-name "Choose the project directory: " dir nil t)
- pr (project--find-in-directory dir))
- (unless pr
- (message "Using `%s' as a transient project root" dir)
- (setq pr (cons 'transient dir)))))
+ ((unless project-current-inhibit-prompt
+ maybe-prompt)
+ (setq directory (project-prompt-project-dir)
+ pr (project--find-in-directory directory))))
+ (when maybe-prompt
+ (if pr
+ (project-remember-project pr)
+ (project--remove-from-project-list directory)
+ (setq pr (cons 'transient directory))))
pr))
(defun project--find-in-directory (dir)
(run-hook-with-args-until-success 'project-find-functions dir))
-(cl-defgeneric project-roots (project)
- "Return the list of directory roots of the current project.
+(cl-defgeneric project-root (project)
+ "Return root directory of the current project.
-Most often it's just one directory which contains the project
-build file and everything else in the project. But in more
-advanced configurations, a project can span multiple directories.
+It usually contains the main build file, dependencies
+configuration file, etc. Though neither is mandatory.
-The directory names should be absolute.")
+The directory name must be absolute."
+ (car (project-roots project)))
+
+(cl-defgeneric project-roots (project)
+ "Return the list containing the current project root.
+
+The function is obsolete, all projects have one main root anyway,
+and the rest should be possible to express through
+`project-external-roots'."
+ ;; FIXME: Can we specify project's version here?
+ ;; FIXME: Could we make this affect cl-defmethod calls too?
+ (declare (obsolete project-root "0.3.0"))
+ (list (project-root project)))
;; FIXME: Add MODE argument, like in `ede-source-paths'?
(cl-defgeneric project-external-roots (_project)
@@ -133,18 +235,14 @@ The directory names should be absolute.")
It's the list of directories outside of the project that are
still related to it. If the project deals with source code then,
depending on the languages used, this list should include the
-headers search path, load path, class path, and so on.
-
-The rule of thumb for whether to include a directory here, and
-not in `project-roots', is whether its contents are meant to be
-edited together with the rest of the project."
+headers search path, load path, class path, and so on."
nil)
(cl-defgeneric project-ignores (_project _dir)
"Return the list of glob patterns to ignore inside DIR.
Patterns can match both regular files and directories.
To root an entry, start it with `./'. To match directories only,
-end it with `/'. DIR must be one of `project-roots' or
+end it with `/'. DIR must be either `project-root' or one of
`project-external-roots'."
;; TODO: Document and support regexp ignores as used by Hg.
;; TODO: Support whitelist entries.
@@ -165,21 +263,22 @@ end it with `/'. DIR must be one of `project-roots' or
(t
(complete-with-action action all-files string pred)))))
-(cl-defmethod project-roots ((project (head transient)))
- (list (cdr project)))
+(cl-defmethod project-root ((project (head transient)))
+ (cdr project))
(cl-defgeneric project-files (project &optional dirs)
"Return a list of files in directories DIRS in PROJECT.
DIRS is a list of absolute directories; it should be some
-subset of the project roots and external roots.
+subset of the project root and external roots.
The default implementation uses `find-program'. PROJECT is used
to find the list of ignores for each directory."
- (cl-mapcan
+ (mapcan
(lambda (dir)
(project--files-in-directory dir
(project--dir-ignores project dir)))
- (or dirs (project-roots project))))
+ (or dirs
+ (list (project-root project)))))
(defun project--files-in-directory (dir ignores &optional files)
(require 'find-dired)
@@ -202,8 +301,8 @@ to find the list of ignores for each directory."
(split-string files)
(concat " -o " find-name-arg " "))
" "
- (shell-quote-argument ")"))"")
- )))
+ (shell-quote-argument ")"))
+ ""))))
(project--remote-file-names
(sort (split-string (shell-command-to-string command) "\0" t)
#'string<))))
@@ -218,14 +317,24 @@ to find the list of ignores for each directory."
local-files))))
(defgroup project-vc nil
- "Project implementation using the VC package."
+ "Project implementation based on the VC package."
:version "25.1"
- :group 'tools)
+ :group 'project)
(defcustom project-vc-ignores nil
"List of patterns to include in `project-ignores'."
:type '(repeat string)
- :safe 'listp)
+ :safe #'listp)
+
+(defcustom project-vc-merge-submodules t
+ "Non-nil to consider submodules part of the parent project.
+
+After changing this variable (using Customize or .dir-locals.el)
+you might have to restart Emacs to see the effect."
+ :type 'boolean
+ :version "28.1"
+ :package-version '(project . "0.2.0")
+ :safe #'booleanp)
;; FIXME: Using the current approach, major modes are supposed to set
;; this variable to a buffer-local value. So we don't have access to
@@ -263,20 +372,56 @@ The directory names should be absolute. Used in the VC project
backend implementation of `project-external-roots'.")
(defun project-try-vc (dir)
- (let* ((backend (ignore-errors (vc-responsible-backend dir)))
+ (let* ((backend
+ ;; FIXME: This is slow. Cache it.
+ (ignore-errors (vc-responsible-backend dir)))
(root
(pcase backend
('Git
;; Don't stop at submodule boundary.
+ ;; FIXME: Cache for a shorter time.
(or (vc-file-getprop dir 'project-git-root)
- (vc-file-setprop dir 'project-git-root
- (vc-find-root dir ".git/"))))
+ (let ((root (vc-call-backend backend 'root dir)))
+ (vc-file-setprop
+ dir 'project-git-root
+ (if (and
+ ;; FIXME: Invalidate the cache when the value
+ ;; of this variable changes.
+ (project--vc-merge-submodules-p root)
+ (project--submodule-p root))
+ (let* ((parent (file-name-directory
+ (directory-file-name root))))
+ (vc-call-backend backend 'root parent))
+ root)))))
('nil nil)
(_ (ignore-errors (vc-call-backend backend 'root dir))))))
(and root (cons 'vc root))))
-(cl-defmethod project-roots ((project (head vc)))
- (list (cdr project)))
+(defun project--submodule-p (root)
+ ;; XXX: We only support Git submodules for now.
+ ;;
+ ;; For submodules, at least, we expect the users to prefer them to
+ ;; be considered part of the parent project. For those who don't,
+ ;; there is the custom var now.
+ ;;
+ ;; Some users may also set up things equivalent to Git submodules
+ ;; using "git worktree" (for example). However, we expect that most
+ ;; of them would prefer to treat those as separate projects anyway.
+ (let* ((gitfile (expand-file-name ".git" root)))
+ (cond
+ ((file-directory-p gitfile)
+ nil)
+ ((with-temp-buffer
+ (insert-file-contents gitfile)
+ (goto-char (point-min))
+ ;; Kind of a hack to distinguish a submodule from
+ ;; other cases of .git files pointing elsewhere.
+ (looking-at "gitdir: [./]+/\\.git/modules/"))
+ t)
+ (t nil))))
+
+(cl-defmethod project-root ((project (head vc)))
+ (cdr project))
(cl-defmethod project-external-roots ((project (head vc)))
(project-subtract-directories
@@ -284,10 +429,10 @@ backend implementation of `project-external-roots'.")
(mapcar
#'file-name-as-directory
(funcall project-vc-external-roots-function)))
- (project-roots project)))
+ (list (project-root project))))
(cl-defmethod project-files ((project (head vc)) &optional dirs)
- (cl-mapcan
+ (mapcan
(lambda (dir)
(let (backend)
(if (and (file-equal-p dir (cdr project))
@@ -302,7 +447,8 @@ backend implementation of `project-external-roots'.")
(project--files-in-directory
dir
(project--dir-ignores project dir)))))
- (or dirs (project-roots project))))
+ (or dirs
+ (list (project-root project)))))
(declare-function vc-git--program-version "vc-git")
(declare-function vc-git--run-command-string "vc-git")
@@ -331,20 +477,23 @@ backend implementation of `project-external-roots'.")
(split-string
(apply #'vc-git--run-command-string nil "ls-files" args)
"\0" t)))
- ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'.
- (let* ((submodules (project--git-submodules))
- (sub-files
- (mapcar
- (lambda (module)
- (when (file-directory-p module)
- (project--vc-list-files
- (concat default-directory module)
- backend
- extra-ignores)))
- submodules)))
- (setq files
- (apply #'nconc files sub-files)))
- files))
+ (when (project--vc-merge-submodules-p default-directory)
+ ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'.
+ (let* ((submodules (project--git-submodules))
+ (sub-files
+ (mapcar
+ (lambda (module)
+ (when (file-directory-p module)
+ (project--vc-list-files
+ (concat default-directory module)
+ backend
+ extra-ignores)))
+ submodules)))
+ (setq files
+ (apply #'nconc files sub-files))))
+ ;; 'git ls-files' returns duplicate entries for merge conflicts.
+ ;; XXX: Better solutions welcome, but this seems cheap enough.
+ (delete-consecutive-dups files)))
(`Hg
(let ((default-directory (expand-file-name (file-name-as-directory dir)))
args)
@@ -362,6 +511,11 @@ backend implementation of `project-external-roots'.")
(lambda (s) (concat default-directory s))
(split-string (buffer-string) "\0" t)))))))
+(defun project--vc-merge-submodules-p (dir)
+ (project--value-in-dir
+ 'project-vc-merge-submodules
+ dir))
+
(defun project--git-submodules ()
;; 'git submodule foreach' is much slower.
(condition-case nil
@@ -376,7 +530,7 @@ backend implementation of `project-external-roots'.")
(cl-defmethod project-ignores ((project (head vc)) dir)
(let* ((root (cdr project))
- backend)
+ backend)
(append
(when (file-equal-p dir root)
(setq backend (vc-responsible-backend root))
@@ -424,6 +578,102 @@ DIRS must contain directory names."
(hack-dir-local-variables-non-file-buffer))
(symbol-value var)))
+
+;;; Project commands
+
+;;;###autoload
+(defvar project-prefix-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "!" 'project-shell-command)
+ (define-key map "&" 'project-async-shell-command)
+ (define-key map "f" 'project-find-file)
+ (define-key map "F" 'project-or-external-find-file)
+ (define-key map "b" 'project-switch-to-buffer)
+ (define-key map "s" 'project-shell)
+ (define-key map "d" 'project-dired)
+ (define-key map "v" 'project-vc-dir)
+ (define-key map "c" 'project-compile)
+ (define-key map "e" 'project-eshell)
+ (define-key map "k" 'project-kill-buffers)
+ (define-key map "p" 'project-switch-project)
+ (define-key map "g" 'project-find-regexp)
+ (define-key map "G" 'project-or-external-find-regexp)
+ (define-key map "r" 'project-query-replace-regexp)
+ map)
+ "Keymap for project commands.")
+
+;;;###autoload (define-key ctl-x-map "p" project-prefix-map)
+
+;; We can't have these place-specific maps inherit from
+;; project-prefix-map because project--other-place-command needs to
+;; know which map the key binding came from, as if it came from one of
+;; these maps, we don't want to set display-buffer-overriding-action
+
+(defvar project-other-window-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-o" #'project-display-buffer)
+ map)
+ "Keymap for project commands that display buffers in other windows.")
+
+(defvar project-other-frame-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-o" #'project-display-buffer-other-frame)
+ map)
+ "Keymap for project commands that display buffers in other frames.")
+
+(defun project--other-place-command (action &optional map)
+ (let* ((key (read-key-sequence-vector nil t))
+ (place-cmd (lookup-key map key))
+ (generic-cmd (lookup-key project-prefix-map key))
+ (switch-to-buffer-obey-display-actions t)
+ (display-buffer-overriding-action (unless place-cmd action)))
+ (if-let ((cmd (or place-cmd generic-cmd)))
+ (call-interactively cmd)
+ (user-error "%s is undefined" (key-description key)))))
+
+;;;###autoload
+(defun project-other-window-command ()
+ "Run project command, displaying resultant buffer in another window.
+
+The following commands are available:
+
+\\{project-prefix-map}
+\\{project-other-window-map}"
+ (interactive)
+ (project--other-place-command '((display-buffer-pop-up-window)
+ (inhibit-same-window . t))
+ project-other-window-map))
+
+;;;###autoload (define-key ctl-x-4-map "p" #'project-other-window-command)
+
+;;;###autoload
+(defun project-other-frame-command ()
+ "Run project command, displaying resultant buffer in another frame.
+
+The following commands are available:
+
+\\{project-prefix-map}
+\\{project-other-frame-map}"
+ (interactive)
+ (project--other-place-command '((display-buffer-pop-up-frame))
+ project-other-frame-map))
+
+;;;###autoload (define-key ctl-x-5-map "p" #'project-other-frame-command)
+
+;;;###autoload
+(defun project-other-tab-command ()
+ "Run project command, displaying resultant buffer in a new tab.
+
+The following commands are available:
+
+\\{project-prefix-map}"
+ (interactive)
+ (project--other-place-command '((display-buffer-in-new-tab))))
+
+;;;###autoload
+(when (bound-and-true-p tab-prefix-map)
+ (define-key tab-prefix-map "p" #'project-other-tab-command))
+
(declare-function grep-read-files "grep")
(declare-function xref--show-xrefs "xref")
(declare-function xref--find-ignores-arguments "xref")
@@ -443,7 +693,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
(let* ((pr (project-current t))
(files
(if (not current-prefix-arg)
- (project-files pr (project-roots pr))
+ (project-files pr)
(let ((dir (read-directory-name "Base directory: "
nil default-directory t)))
(project--files-in-directory dir
@@ -454,9 +704,8 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
nil)))
(defun project--dir-ignores (project dir)
- (let* ((roots (project-roots project))
- (root (cl-find dir roots :test #'file-in-directory-p)))
- (if (not root)
+ (let ((root (project-root project)))
+ (if (not (file-in-directory-p dir root))
(project-ignores nil nil) ;The defaults.
(let ((ignores (project-ignores project root)))
(if (file-equal-p root dir)
@@ -474,8 +723,8 @@ pattern to search for."
(require 'xref)
(let* ((pr (project-current t))
(files
- (project-files pr (append
- (project-roots pr)
+ (project-files pr (cons
+ (project-root pr)
(project-external-roots pr)))))
(xref--show-xrefs
(apply-partially #'project--find-regexp-in-files regexp files)
@@ -489,47 +738,27 @@ pattern to search for."
(user-error "No matches for: %s" regexp))
xrefs))
-(defun project--process-file-region (start end program
- &optional buffer display
- &rest args)
- ;; FIXME: This branching shouldn't be necessary, but
- ;; call-process-region *is* measurably faster, even for a program
- ;; doing some actual work (for a period of time). Even though
- ;; call-process-region also creates a temp file internally
- ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html).
- (if (not (file-remote-p default-directory))
- (apply #'call-process-region
- start end program nil buffer display args)
- (let ((infile (make-temp-file "ppfr")))
- (unwind-protect
- (progn
- (write-region start end infile nil 'silent)
- (apply #'process-file program infile buffer display args))
- (delete-file infile)))))
-
(defun project--read-regexp ()
(let ((sym (thing-at-point 'symbol)))
(read-regexp "Find regexp" (and sym (regexp-quote sym)))))
;;;###autoload
(defun project-find-file ()
- "Visit a file (with completion) in the current project's roots.
-The completion default is the filename at point, if one is
-recognized."
+ "Visit a file (with completion) in the current project.
+The completion default is the string at point."
(interactive)
(let* ((pr (project-current t))
- (dirs (project-roots pr)))
+ (dirs (list (project-root pr))))
(project-find-file-in (thing-at-point 'filename) dirs pr)))
;;;###autoload
(defun project-or-external-find-file ()
- "Visit a file (with completion) in the current project's roots or external roots.
-The completion default is the filename at point, if one is
-recognized."
+ "Visit a file (with completion) in the current project or external roots.
+The completion default is the string at point."
(interactive)
(let* ((pr (project-current t))
- (dirs (append
- (project-roots pr)
+ (dirs (cons
+ (project-root pr)
(project-external-roots pr))))
(project-find-file-in (thing-at-point 'filename) dirs pr)))
@@ -541,6 +770,7 @@ For the arguments list, see `project--read-file-cpd-relative'."
(const :tag "Read with completion from absolute names"
project--read-file-absolute)
(function :tag "Custom function" nil))
+ :group 'project
:version "27.1")
(defun project--read-file-cpd-relative (prompt
@@ -577,9 +807,10 @@ PREDICATE, HIST, and DEFAULT have the same meaning as in
(defun project-find-file-in (filename dirs project)
"Complete FILENAME in DIRS in PROJECT and visit the result."
(let* ((all-files (project-files project dirs))
+ (completion-ignore-case read-file-name-completion-ignore-case)
(file (funcall project-read-file-name-function
- "Find file" all-files nil nil
- filename)))
+ "Find file" all-files nil nil
+ filename)))
(if (string= file "")
(user-error "You didn't specify the file")
(find-file file))))
@@ -605,6 +836,71 @@ PREDICATE, HIST, and DEFAULT have the same meaning as in
collection predicate t res hist nil)))
res))
+;;;###autoload
+(defun project-dired ()
+ "Start Dired in the current project's root."
+ (interactive)
+ (dired (project-root (project-current t))))
+
+;;;###autoload
+(defun project-vc-dir ()
+ "Run VC-Dir in the current project's root."
+ (interactive)
+ (vc-dir (project-root (project-current t))))
+
+;;;###autoload
+(defun project-shell ()
+ "Start an inferior shell in the current project's root directory.
+If a buffer already exists for running a shell in the project's root,
+switch to it. Otherwise, create a new shell buffer.
+With \\[universal-argument] prefix arg, create a new inferior shell buffer even
+if one already exists."
+ (interactive)
+ (let* ((default-directory (project-root (project-current t)))
+ (default-project-shell-name
+ (concat "*" (file-name-nondirectory
+ (directory-file-name
+ (file-name-directory default-directory)))
+ "-shell*"))
+ (shell-buffer (get-buffer default-project-shell-name)))
+ (if (and shell-buffer (not current-prefix-arg))
+ (pop-to-buffer shell-buffer)
+ (shell (generate-new-buffer-name default-project-shell-name)))))
+
+;;;###autoload
+(defun project-eshell ()
+ "Start Eshell in the current project's root directory.
+If a buffer already exists for running Eshell in the project's root,
+switch to it. Otherwise, create a new Eshell buffer.
+With \\[universal-argument] prefix arg, create a new Eshell buffer even
+if one already exists."
+ (interactive)
+ (defvar eshell-buffer-name)
+ (let* ((default-directory (project-root (project-current t)))
+ (eshell-buffer-name
+ (concat "*" (file-name-nondirectory
+ (directory-file-name
+ (file-name-directory default-directory)))
+ "-eshell*"))
+ (eshell-buffer (get-buffer eshell-buffer-name)))
+ (if (and eshell-buffer (not current-prefix-arg))
+ (pop-to-buffer eshell-buffer)
+ (eshell t))))
+
+;;;###autoload
+(defun project-async-shell-command ()
+ "Run `async-shell-command' in the current project's root directory."
+ (interactive)
+ (let ((default-directory (project-root (project-current t))))
+ (call-interactively #'async-shell-command)))
+
+;;;###autoload
+(defun project-shell-command ()
+ "Run `shell-command' in the current project's root directory."
+ (interactive)
+ (let ((default-directory (project-root (project-current t))))
+ (call-interactively #'shell-command)))
+
(declare-function fileloop-continue "fileloop" ())
;;;###autoload
@@ -632,5 +928,330 @@ loop using the command \\[fileloop-continue]."
from to (project-files (project-current t)) 'default)
(fileloop-continue))
+(defvar compilation-read-command)
+(declare-function compilation-read-command "compile")
+
+;;;###autoload
+(defun project-compile (command &optional comint)
+ "Run `compile' in the project root.
+Arguments the same as in `compile'."
+ (interactive
+ (list
+ (let ((command (eval compile-command)))
+ (require 'compile)
+ (if (or compilation-read-command current-prefix-arg)
+ (compilation-read-command command)
+ command))
+ (consp current-prefix-arg)))
+ (let* ((pr (project-current t))
+ (default-directory (project-root pr)))
+ (compile command comint)))
+
+(defun project--read-project-buffer ()
+ (let* ((pr (project-current t))
+ (current-buffer (current-buffer))
+ (other-buffer (other-buffer current-buffer))
+ (other-name (buffer-name other-buffer))
+ (predicate
+ (lambda (buffer)
+ ;; BUFFER is an entry (BUF-NAME . BUF-OBJ) of Vbuffer_alist.
+ (and (cdr buffer)
+ (equal pr
+ (with-current-buffer (cdr buffer)
+ (project-current)))))))
+ (read-buffer
+ "Switch to buffer: "
+ (when (funcall predicate (cons other-name other-buffer))
+ other-name)
+ nil
+ predicate)))
+
+;;;###autoload
+(defun project-switch-to-buffer (buffer-or-name)
+ "Display buffer BUFFER-OR-NAME in the selected window.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical."
+ (interactive (list (project--read-project-buffer)))
+ (switch-to-buffer buffer-or-name))
+
+;;;###autoload
+(defun project-display-buffer (buffer-or-name)
+ "Display BUFFER-OR-NAME in some window, without selecting it.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical.
+
+This function uses `display-buffer' as a subroutine, which see
+for how it is determined where the buffer will be displayed."
+ (interactive (list (project--read-project-buffer)))
+ (display-buffer buffer-or-name))
+
+;;;###autoload
+(defun project-display-buffer-other-frame (buffer-or-name)
+ "Display BUFFER-OR-NAME preferably in another frame.
+When called interactively, prompts for a buffer belonging to the
+current project. Two buffers belong to the same project if their
+project instances, as reported by `project-current' in each
+buffer, are identical.
+
+This function uses `display-buffer-other-frame' as a subroutine,
+which see for how it is determined where the buffer will be
+displayed."
+ (interactive (list (project--read-project-buffer)))
+ (display-buffer-other-frame buffer-or-name))
+
+(defcustom project-kill-buffer-conditions
+ '(buffer-file-name ; All file-visiting buffers are included.
+ ;; Most of the temp buffers in the background:
+ (major-mode . fundamental-mode)
+ ;; non-text buffer such as xref, occur, vc, log, ...
+ (and (derived-mode . special-mode)
+ (not (major-mode . help-mode)))
+ (derived-mode . compilation-mode)
+ (derived-mode . dired-mode)
+ (derived-mode . diff-mode))
+ "List of conditions to kill buffers related to a project.
+This list is used by `project-kill-buffers'.
+Each condition is either:
+- a regular expression, to match a buffer name,
+- a predicate function that takes a buffer object as argument
+ and returns non-nil if the buffer should be killed,
+- a cons-cell, where the car describes how to interpret the cdr.
+ The car can be one of the following:
+ * `major-mode': the buffer is killed if the buffer's major
+ mode is eq to the cons-cell's cdr
+ * `derived-mode': the buffer is killed if the buffer's major
+ mode is derived from the major mode denoted by the cons-cell's
+ cdr
+ * `not': the cdr is interpreted as a negation of a condition.
+ * `and': the cdr is a list of recursive conditions, that all have
+ to be met.
+ * `or': the cdr is a list of recursive conditions, of which at
+ least one has to be met.
+
+If any of these conditions are satisfied for a buffer in the
+current project, it will be killed."
+ :type '(repeat (choice regexp function symbol
+ (cons :tag "Major mode"
+ (const major-mode) symbol)
+ (cons :tag "Derived mode"
+ (const derived-mode) symbol)
+ (cons :tag "Negation"
+ (const not) sexp)
+ (cons :tag "Conjunction"
+ (const and) sexp)
+ (cons :tag "Disjunction"
+ (const or) sexp)))
+ :version "28.1"
+ :group 'project
+ :package-version '(project . "0.6.0"))
+
+(defun project--buffer-list (pr)
+ "Return the list of all buffers in project PR."
+ (let (bufs)
+ (dolist (buf (buffer-list))
+ (when (equal pr
+ (with-current-buffer buf
+ (project-current)))
+ (push buf bufs)))
+ (nreverse bufs)))
+
+(defun project--kill-buffer-check (buf conditions)
+ "Check if buffer BUF matches any element of the list CONDITIONS.
+See `project-kill-buffer-conditions' for more details on the form
+of CONDITIONS."
+ (catch 'kill
+ (dolist (c conditions)
+ (when (cond
+ ((stringp c)
+ (string-match-p c (buffer-name buf)))
+ ((symbolp c)
+ (funcall c buf))
+ ((eq (car-safe c) 'major-mode)
+ (eq (buffer-local-value 'major-mode buf)
+ (cdr c)))
+ ((eq (car-safe c) 'derived-mode)
+ (provided-mode-derived-p
+ (buffer-local-value 'major-mode buf)
+ (cdr c)))
+ ((eq (car-safe c) 'not)
+ (not (project--kill-buffer-check buf (cdr c))))
+ ((eq (car-safe c) 'or)
+ (project--kill-buffer-check buf (cdr c)))
+ ((eq (car-safe c) 'and)
+ (seq-every-p
+ (apply-partially #'project--kill-buffer-check
+ buf)
+ (mapcar #'list (cdr c)))))
+ (throw 'kill t)))))
+
+(defun project--buffers-to-kill (pr)
+ "Return list of buffers in project PR to kill.
+What buffers should or should not be killed is described
+in `project-kill-buffer-conditions'."
+ (let (bufs)
+ (dolist (buf (project--buffer-list pr))
+ (when (project--kill-buffer-check buf project-kill-buffer-conditions)
+ (push buf bufs)))
+ bufs))
+
+;;;###autoload
+(defun project-kill-buffers (&optional no-confirm)
+ "Kill the buffers belonging to the current project.
+Two buffers belong to the same project if their project
+instances, as reported by `project-current' in each buffer, are
+identical. Only the buffers that match a condition in
+`project-kill-buffer-conditions' will be killed. If NO-CONFIRM
+is non-nil, the command will not ask the user for confirmation.
+NO-CONFIRM is always nil when the command is invoked
+interactively."
+ (interactive)
+ (let* ((pr (project-current t))
+ (bufs (project--buffers-to-kill pr)))
+ (cond (no-confirm
+ (mapc #'kill-buffer bufs))
+ ((null bufs)
+ (message "No buffers to kill"))
+ ((yes-or-no-p (format "Kill %d buffers in %s? "
+ (length bufs)
+ (project-root pr)))
+ (mapc #'kill-buffer bufs)))))
+
+
+;;; Project list
+
+(defcustom project-list-file (locate-user-emacs-file "projects")
+ "File in which to save the list of known projects."
+ :type 'file
+ :version "28.1"
+ :group 'project)
+
+(defvar project--list 'unset
+ "List structure containing root directories of known projects.
+With some possible metadata (to be decided).")
+
+(defun project--read-project-list ()
+ "Initialize `project--list' using contents of `project-list-file'."
+ (let ((filename project-list-file))
+ (setq project--list
+ (when (file-exists-p filename)
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (read (current-buffer)))))
+ (unless (seq-every-p
+ (lambda (elt) (stringp (car-safe elt)))
+ project--list)
+ (warn "Contents of %s are in wrong format, resetting"
+ project-list-file)
+ (setq project--list nil))))
+
+(defun project--ensure-read-project-list ()
+ "Initialize `project--list' if it isn't already initialized."
+ (when (eq project--list 'unset)
+ (project--read-project-list)))
+
+(defun project--write-project-list ()
+ "Save `project--list' in `project-list-file'."
+ (let ((filename project-list-file))
+ (with-temp-buffer
+ (insert ";;; -*- lisp-data -*-\n")
+ (let ((print-length nil)
+ (print-level nil))
+ (pp project--list (current-buffer)))
+ (write-region nil nil filename nil 'silent))))
+
+;;;###autoload
+(defun project-remember-project (pr)
+ "Add project PR to the front of the project list.
+Save the result in `project-list-file' if the list of projects has changed."
+ (project--ensure-read-project-list)
+ (let ((dir (project-root pr)))
+ (unless (equal (caar project--list) dir)
+ (dolist (ent project--list)
+ (when (equal dir (car ent))
+ (setq project--list (delq ent project--list))))
+ (push (list dir) project--list)
+ (project--write-project-list))))
+
+(defun project--remove-from-project-list (pr-dir)
+ "Remove directory PR-DIR of a missing project from the project list.
+If the directory was in the list before the removal, save the
+result in `project-list-file'. Announce the project's removal
+from the list."
+ (project--ensure-read-project-list)
+ (when-let ((ent (assoc pr-dir project--list)))
+ (setq project--list (delq ent project--list))
+ (message "Project `%s' not found; removed from list" pr-dir)
+ (project--write-project-list)))
+
+(defun project-prompt-project-dir ()
+ "Prompt the user for a directory that is one of the known project roots.
+The project is chosen among projects known from the project list,
+see `project-list-file'.
+It's also possible to enter an arbitrary directory not in the list."
+ (project--ensure-read-project-list)
+ (let* ((dir-choice "... (choose a dir)")
+ (choices
+ ;; XXX: Just using this for the category (for the substring
+ ;; completion style).
+ (project--file-completion-table
+ (append project--list `(,dir-choice))))
+ (pr-dir (completing-read "Select project: " choices nil t)))
+ (if (equal pr-dir dir-choice)
+ (read-directory-name "Select directory: " default-directory nil t)
+ pr-dir)))
+
+;;;###autoload
+(defun project-known-project-roots ()
+ "Return the list of root directories of all known projects."
+ (project--ensure-read-project-list)
+ (mapcar #'car project--list))
+
+
+;;; Project switching
+
+;;;###autoload
+(defvar project-switch-commands
+ '((?f "Find file" project-find-file)
+ (?g "Find regexp" project-find-regexp)
+ (?d "Dired" project-dired)
+ (?v "VC-Dir" project-vc-dir)
+ (?e "Eshell" project-eshell))
+ "Alist mapping keys to project switching menu entries.
+Used by `project-switch-project' to construct a dispatch menu of
+commands available upon \"switching\" to another project.
+
+Each element is of the form (KEY LABEL COMMAND), where COMMAND is the
+command to run when KEY is pressed. LABEL is used to distinguish
+the menu entries in the dispatch menu.")
+
+(defun project--keymap-prompt ()
+ "Return a prompt for the project switching dispatch menu."
+ (mapconcat
+ (pcase-lambda (`(,key ,label))
+ (format "[%s] %s"
+ (propertize (key-description `(,key)) 'face 'bold)
+ label))
+ project-switch-commands
+ " "))
+
+;;;###autoload
+(defun project-switch-project ()
+ "\"Switch\" to another project by running an Emacs command.
+The available commands are presented as a dispatch menu
+made from `project-switch-commands'."
+ (interactive)
+ (let ((dir (project-prompt-project-dir))
+ (choice nil))
+ (while (not choice)
+ (setq choice (assq (read-event (project--keymap-prompt))
+ project-switch-commands)))
+ (let ((default-directory dir)
+ (project-current-inhibit-prompt t))
+ (call-interactively (nth 2 choice)))))
+
(provide 'project)
;;; project.el ends here
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 99b57354e25..124f652ed69 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -271,10 +271,6 @@
(require 'easymenu)
(require 'align)
-(eval-when-compile
- (or (fboundp 'use-region-p)
- (defsubst use-region-p () (region-exists-p))))
-
(defgroup prolog nil
"Editing and running Prolog and Mercury files."
:group 'languages)
@@ -780,12 +776,6 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
(modify-syntax-entry ?> "." table)
(modify-syntax-entry ?| "." table)
(modify-syntax-entry ?\' "\"" table)
-
- ;; Any better way to handle the 0'<char> construct?!?
- (when (and prolog-char-quote-workaround
- (not (fboundp 'syntax-propertize-rules)))
- (modify-syntax-entry ?0 "\\" table))
-
(modify-syntax-entry ?% "<" table)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?* ". 23b" table)
@@ -1051,21 +1041,19 @@ VERSION is of the format (Major . Minor)"
alist)))
(defconst prolog-syntax-propertize-function
- (when (fboundp 'syntax-propertize-rules)
- (syntax-propertize-rules
- ;; GNU Prolog only accepts 0'\' rather than 0'', but the only
- ;; possible meaning of 0'' is rather clear.
- ("\\<0\\(''?\\)"
- (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
- (string-to-syntax "_"))))
- ;; We could check that we're not inside an atom, but I don't think
- ;; that 'foo 8'z could be a valid syntax anyway, so why bother?
- ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_"))
- ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal
- ;; escape sequences in atoms, so be careful not to let the terminating \
- ;; escape a subsequent quote.
- ("\\\\[x0-7][[:xdigit:]]*\\(\\\\\\)" (1 "_"))
- )))
+ (syntax-propertize-rules
+ ;; GNU Prolog only accepts 0'\' rather than 0'', but the only
+ ;; possible meaning of 0'' is rather clear.
+ ("\\<0\\(''?\\)"
+ (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax "_"))))
+ ;; We could check that we're not inside an atom, but I don't think
+ ;; that 'foo 8'z could be a valid syntax anyway, so why bother?
+ ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_"))
+ ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal
+ ;; escape sequences in atoms, so be careful not to let the terminating \
+ ;; escape a subsequent quote.
+ ("\\\\[x0-7][[:xdigit:]]*\\(\\\\\\)" (1 "_"))))
(defun prolog-mode-variables ()
"Set some common variables to Prolog code specific values."
@@ -1890,14 +1878,7 @@ Argument BOUND is a buffer position limiting searching."
bound t)))
point))
-(defsubst prolog-face-name-p (facename)
- ;; Return t if FACENAME is the name of a face. This method is
- ;; necessary since facep in XEmacs only returns t for the actual
- ;; face objects (while it's only their names that are used just
- ;; about anywhere else) without providing a predicate that tests
- ;; face names. This function (including the above commentary) is
- ;; borrowed from cc-mode.
- (memq facename (face-list)))
+(define-obsolete-function-alias 'prolog-face-name-p 'facep "28.1")
;; Set everything up
(defun prolog-font-lock-keywords ()
@@ -1932,6 +1913,8 @@ Argument BOUND is a buffer position limiting searching."
(t (:underline t)))
"Face name to use for compiler warnings."
:group 'prolog-faces)
+ (define-obsolete-face-alias 'prolog-warning-face
+ 'font-lock-warning-face "28.1")
(defface prolog-builtin-face
'((((class color) (background light)) (:foreground "Purple"))
(((class color) (background dark)) (:foreground "Cyan"))
@@ -1941,15 +1924,11 @@ Argument BOUND is a buffer position limiting searching."
(t (:bold t)))
"Face name to use for compiler warnings."
:group 'prolog-faces)
- (defvar prolog-warning-face
- (if (prolog-face-name-p 'font-lock-warning-face)
- 'font-lock-warning-face
- 'prolog-warning-face)
+ (define-obsolete-face-alias 'prolog-builtin-face
+ 'font-lock-builtin-face "28.1")
+ (defvar prolog-warning-face 'font-lock-warning-face
"Face name to use for built in predicates.")
- (defvar prolog-builtin-face
- (if (prolog-face-name-p 'font-lock-builtin-face)
- 'font-lock-builtin-face
- 'prolog-builtin-face)
+ (defvar prolog-builtin-face 'font-lock-builtin-face
"Face name to use for built in predicates.")
(defvar prolog-redo-face 'prolog-redo-face
"Face name to use for redo trace lines.")
@@ -2295,12 +2274,12 @@ between them)."
(progn
(goto-char cbeg)
(search-forward-regexp "%+[ \t]*" end t)
- (prolog-replace-in-string (buffer-substring beg (point))
- "[^ \t%]" " "))
+ (replace-regexp-in-string "[^ \t%]" " "
+ (buffer-substring beg (point))))
;(goto-char beg)
(if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*"
end t)
- (prolog-replace-in-string (buffer-substring beg (point)) "/" " ")
+ (replace-regexp-in-string "/" " " (buffer-substring beg (point)))
(beginning-of-line)
(when (search-forward-regexp "^[ \t]+" end t)
(buffer-substring beg (point)))))))))
@@ -2340,11 +2319,10 @@ In effect it sets the `fill-prefix' when inside comments and then calls
(do-auto-fill)
))
-(defalias 'prolog-replace-in-string
- (if (fboundp 'replace-in-string)
- #'replace-in-string
- (lambda (str regexp newtext &optional literal)
- (replace-regexp-in-string regexp newtext str nil literal))))
+(defun prolog-replace-in-string (str regexp newtext &optional literal)
+ (declare (obsolete replace-regexp-in-string "28.1"))
+ (replace-regexp-in-string regexp newtext str nil literal))
+
;;-------------------------------------------------------------------
;; Online help
@@ -2373,12 +2351,8 @@ In effect it sets the `fill-prefix' when inside comments and then calls
;; in prolog-help-function-i
(t
(let* ((word (prolog-atom-under-point))
- (predicate (read-string
- (format "Help on predicate%s: "
- (if word
- (concat " (default " word ")")
- ""))
- nil nil word))
+ (predicate (read-string (format-prompt "Help on predicate" word)
+ nil nil word))
;;point
)
(if prolog-help-function-i
@@ -2752,20 +2726,6 @@ When called with prefix argument ARG, disable zipping instead."
(nth 1 state)))
))))
-;; For backward compatibility. Stolen from custom.el.
-(or (fboundp 'match-string)
- ;; Introduced in Emacs 19.29.
- (defun match-string (num &optional string)
- "Return string of text matched by last search.
-NUM specifies which parenthesized expression in the last regexp.
- Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
-Zero means the entire text matched by the whole regexp or whole string.
-STRING should be given if the last search was by `string-match' on STRING."
- (if (match-beginning num)
- (if string
- (substring string (match-beginning num) (match-end num))
- (buffer-substring (match-beginning num) (match-end num))))))
-
(defun prolog-pred-start ()
"Return the starting point of the first clause of the current predicate."
;; FIXME: Use SMIE.
@@ -3105,12 +3065,8 @@ The module name should be written manually just before the semi-colon."
(insert "%%% -*- Module: ; -*-\n")
(backward-char 6))
-(defalias 'prolog-uncomment-region
- (if (fboundp 'uncomment-region) #'uncomment-region
- (lambda (beg end)
- "Uncomment the region between BEG and END."
- (interactive "r")
- (comment-region beg end -1))))
+(define-obsolete-function-alias 'prolog-uncomment-region
+ 'uncomment-region "28.1")
(defun prolog-indent-predicate ()
"Indent the current predicate."
@@ -3396,7 +3352,7 @@ PREFIX is the prefix of the search regexp."
"Commands for Prolog code manipulation."
'("Prolog"
["Comment region" comment-region (use-region-p)]
- ["Uncomment region" prolog-uncomment-region (use-region-p)]
+ ["Uncomment region" uncomment-region (use-region-p)]
["Add comment/move to comment" indent-for-comment t]
["Convert variables in region to '_'" prolog-variables-to-anonymous
:active (use-region-p) :included (not (eq prolog-system 'mercury))]
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 2d47cdc4068..091456aa89a 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -4,7 +4,7 @@
;; Author: Fabián E. Gallina <fgallina@gnu.org>
;; URL: https://github.com/fgallina/python.el
-;; Version: 0.26.1
+;; Version: 0.27
;; Package-Requires: ((emacs "24.1") (cl-lib "1.0"))
;; Maintainer: emacs-devel@gnu.org
;; Created: Jul 2010
@@ -29,7 +29,7 @@
;; Major mode for editing Python files with some fontification and
;; indentation bits extracted from original Dave Love's python.el
-;; found in GNU/Emacs.
+;; found in GNU Emacs.
;; Implements Syntax highlighting, Indentation, Movement, Shell
;; interaction, Shell completion, Shell virtualenv support, Shell
@@ -135,7 +135,7 @@
;; values enable completion for both CPython and IPython, and probably
;; any readline based shell (it's known to work with PyPy). If your
;; Python installation lacks readline (like CPython for Windows),
-;; installing pyreadline (URL `http://ipython.org/pyreadline.html')
+;; installing pyreadline (URL `https://ipython.org/pyreadline.html')
;; should suffice. To troubleshoot why you are not getting any
;; completions, you can try the following in your Python shell:
@@ -247,13 +247,6 @@
;; I'd recommend the first one since you'll get the same behavior for
;; all modes out-of-the-box.
-;;; Installation:
-
-;; Add this to your .emacs:
-
-;; (add-to-list 'load-path "/folder/containing/file")
-;; (require 'python)
-
;;; TODO:
;;; Code:
@@ -261,7 +254,6 @@
(require 'ansi-color)
(require 'cl-lib)
(require 'comint)
-(require 'json)
(require 'tramp-sh)
;; Avoid compiler warnings
@@ -284,24 +276,6 @@
:link '(emacs-commentary-link "python"))
-;;; 24.x Compat
-
-
-(eval-and-compile
- (unless (fboundp 'prog-first-column)
- (defun prog-first-column ()
- 0))
- (unless (fboundp 'file-local-name)
- (defun file-local-name (file)
- "Return the local name component of FILE.
-It returns a file name which can be used directly as argument of
-`process-file', `start-file-process', or `shell-command'."
- (or (file-remote-p file 'localname) file))))
-
-;; In Emacs 24.3 and earlier, `define-derived-mode' does not define
-;; the hook variable, it only puts documentation on the symbol.
-(defvar inferior-python-mode-hook)
-
;;; Bindings
@@ -520,6 +494,52 @@ The type returned can be `comment', `string' or `paren'."
font-lock-string-face)
font-lock-comment-face))
+(defun python--f-string-p (ppss)
+ "Return non-nil if the pos where PPSS was found is inside an f-string."
+ (and (nth 3 ppss)
+ (let ((spos (1- (nth 8 ppss))))
+ (and (memq (char-after spos) '(?f ?F))
+ (or (< (point-min) spos)
+ (not (memq (char-syntax (char-before spos)) '(?w ?_))))))))
+
+(defun python--font-lock-f-strings (limit)
+ "Mark {...} holes as being code.
+Remove the (presumably `font-lock-string-face') `face' property from
+the {...} holes that appear within f-strings."
+ ;; FIXME: This will fail to properly highlight strings appearing
+ ;; within the {...} of an f-string.
+ ;; We could presumably fix it by running
+ ;; `font-lock-fontify-syntactically-region' (as is done in
+ ;; `sm-c--cpp-fontify-syntactically', for example) after removing
+ ;; the `face' property, but I'm not sure it's worth the effort and
+ ;; the risks.
+ (let ((ppss (syntax-ppss)))
+ (while
+ (progn
+ (while (and (not (python--f-string-p ppss))
+ (re-search-forward "\\<f['\"]" limit 'move))
+ (setq ppss (syntax-ppss)))
+ (< (point) limit))
+ (cl-assert (python--f-string-p ppss))
+ (let ((send (save-excursion
+ (goto-char (nth 8 ppss))
+ (condition-case nil
+ (progn (let ((forward-sexp-function nil))
+ (forward-sexp 1))
+ (min limit (1- (point))))
+ (scan-error limit)))))
+ (while (re-search-forward "{" send t)
+ (if (eq ?\{ (char-after))
+ (forward-char 1) ;Just skip over {{
+ (let ((beg (match-beginning 0))
+ (end (condition-case nil
+ (progn (up-list 1) (min send (point)))
+ (scan-error send))))
+ (goto-char end)
+ (put-text-property beg end 'face nil))))
+ (goto-char (min limit (1+ send)))
+ (setq ppss (syntax-ppss))))))
+
(defvar python-font-lock-keywords-level-1
`((,(rx symbol-start "def" (1+ space) (group (1+ (or word ?_))))
(1 font-lock-function-name-face))
@@ -586,7 +606,8 @@ This is the medium decoration level, including everything in
builtins.")
(defvar python-font-lock-keywords-maximum-decoration
- `(,@python-font-lock-keywords-level-2
+ `((python--font-lock-f-strings)
+ ,@python-font-lock-keywords-level-2
;; Constants
(,(rx symbol-start
(or
@@ -594,7 +615,8 @@ builtins.")
;; copyright, license, credits, quit and exit are added by the site
;; module and they are not intended to be used in programs
"copyright" "credits" "exit" "license" "quit")
- symbol-end) . font-lock-constant-face)
+ symbol-end)
+ . font-lock-constant-face)
;; Decorators.
(,(rx line-start (* (any " \t")) (group "@" (1+ (or word ?_))
(0+ "." (1+ (or word ?_)))))
@@ -628,12 +650,16 @@ builtins.")
;; OS specific
"VMSError" "WindowsError"
)
- symbol-end) . font-lock-type-face)
+ symbol-end)
+ . font-lock-type-face)
;; assignments
;; support for a = b = c = 5
(,(lambda (limit)
- (let ((re (python-rx (group (+ (any word ?. ?_)))
- (? ?\[ (+ (not (any ?\]))) ?\]) (* space)
+ (let ((re (python-rx (group symbol-name)
+ ;; subscript, like "[5]"
+ (? ?\[ (+ (not ?\])) ?\]) (* space)
+ ;; type hint, like ": int" or ": Mapping[int, str]"
+ (? ?: (* space) (+ not-simple-operator) (* space))
assignment-operator))
(res nil))
(while (and (setq res (re-search-forward re limit t))
@@ -643,9 +669,9 @@ builtins.")
(1 font-lock-variable-name-face nil nil))
;; support for a, b, c = (1, 2, 3)
(,(lambda (limit)
- (let ((re (python-rx (group (+ (any word ?. ?_))) (* space)
- (* ?, (* space) (+ (any word ?. ?_)) (* space))
- ?, (* space) (+ (any word ?. ?_)) (* space)
+ (let ((re (python-rx (group symbol-name) (* space)
+ (* ?, (* space) symbol-name (* space))
+ ?, (* space) symbol-name (* space)
assignment-operator))
(res nil))
(while (and (setq res (re-search-forward re limit t))
@@ -1993,7 +2019,7 @@ position, else returns nil."
;; IPython prompts activated, this adds some safeguard for that.
"In : " "\\.\\.\\.: ")
"List of regular expressions matching input prompts."
- :type '(repeat string)
+ :type '(repeat regexp)
:version "24.4")
(defcustom python-shell-prompt-output-regexps
@@ -2001,28 +2027,28 @@ position, else returns nil."
"Out\\[[0-9]+\\]: " ; IPython
"Out :") ; ipdb safeguard
"List of regular expressions matching output prompts."
- :type '(repeat string)
+ :type '(repeat regexp)
:version "24.4")
(defcustom python-shell-prompt-regexp ">>> "
"Regular expression matching top level input prompt of Python shell.
It should not contain a caret (^) at the beginning."
- :type 'string)
+ :type 'regexp)
(defcustom python-shell-prompt-block-regexp "\\.\\.\\.:? "
"Regular expression matching block input prompt of Python shell.
It should not contain a caret (^) at the beginning."
- :type 'string)
+ :type 'regexp)
(defcustom python-shell-prompt-output-regexp ""
"Regular expression matching output prompt of Python shell.
It should not contain a caret (^) at the beginning."
- :type 'string)
+ :type 'regexp)
(defcustom python-shell-prompt-pdb-regexp "[(<]*[Ii]?[Pp]db[>)]+ "
"Regular expression matching pdb input prompt of Python shell.
It should not contain a caret (^) at the beginning."
- :type 'string)
+ :type 'regexp)
(define-obsolete-variable-alias
'python-shell-enable-font-lock 'python-shell-font-lock-enable "25.1")
@@ -2076,7 +2102,7 @@ that they are prioritized when looking for executables."
When this variable is non-nil, values are exported into remote
hosts PATH before starting processes. Values defined in
`python-shell-exec-path' will take precedence to paths defined
-here. Normally you wont use this variable directly unless you
+here. Normally you won't use this variable directly unless you
plan to ensure a particular set of paths to all Python shell
executed through tramp connections."
:version "25.1"
@@ -2091,7 +2117,7 @@ executed through tramp connections."
This variable, when set to a string, makes the environment to be
modified such that shells are started within the specified
virtualenv."
- :type '(choice (const nil) string)
+ :type '(choice (const nil) directory)
:group 'python)
(defcustom python-shell-setup-codes nil
@@ -2111,7 +2137,7 @@ virtualenv."
"(" (group (1+ digit)) ")" (1+ (not (any "("))) "()")
1 2))
"`compilation-error-regexp-alist' for inferior Python."
- :type '(alist string)
+ :type '(alist regexp)
:group 'python)
(defmacro python-shell--add-to-path-with-priority (pathvar paths)
@@ -2276,6 +2302,18 @@ Do not set this variable directly, instead use
Do not set this variable directly, instead use
`python-shell-prompt-set-calculated-regexps'.")
+(defalias 'python--parse-json-array
+ (if (fboundp 'json-parse-string)
+ (lambda (string)
+ (json-parse-string string :array-type 'list))
+ (require 'json)
+ (defvar json-array-type)
+ (declare-function json-read-from-string "json" (string))
+ (lambda (string)
+ (let ((json-array-type 'list))
+ (json-read-from-string string))))
+ "Parse the JSON array in STRING into a Lisp list.")
+
(defun python-shell-prompt-detect ()
"Detect prompts for the current `python-shell-interpreter'.
When prompts can be retrieved successfully from the
@@ -2324,11 +2362,11 @@ detection and just returns nil."
(catch 'prompts
(dolist (line (split-string output "\n" t))
(let ((res
- ;; Check if current line is a valid JSON array
- (and (string= (substring line 0 2) "[\"")
+ ;; Check if current line is a valid JSON array.
+ (and (string-prefix-p "[\"" line)
(ignore-errors
- ;; Return prompts as a list, not vector
- (append (json-read-from-string line) nil)))))
+ ;; Return prompts as a list.
+ (python--parse-json-array line)))))
;; The list must contain 3 strings, where the first
;; is the input prompt, the second is the block
;; prompt and the last one is the output prompt. The
@@ -2798,6 +2836,7 @@ variable.
python-shell-comint-watch-for-first-prompt-output-filter
python-comint-postoutput-scroll-to-bottom
comint-watch-for-password-prompt))
+ (setq-local comint-highlight-input nil)
(set (make-local-variable 'compilation-error-regexp-alist)
python-shell-compilation-regexp-alist)
(add-hook 'completion-at-point-functions
@@ -2876,7 +2915,7 @@ process buffer for a list of commands.)"
(python-shell-make-comint
(or cmd (python-shell-calculate-command))
(python-shell-get-process-name dedicated) show)))
- (pop-to-buffer buffer)
+ (set-buffer buffer)
(get-buffer-process buffer)))
(defun run-python-internal ()
@@ -3080,7 +3119,7 @@ Returns the output. See `python-shell-send-string-no-output'."
(define-obsolete-function-alias
'python-send-string 'python-shell-internal-send-string "24.3")
-(defun python-shell-buffer-substring (start end &optional nomain)
+(defun python-shell-buffer-substring (start end &optional nomain no-cookie)
"Send buffer substring from START to END formatted for shell.
This is a wrapper over `buffer-substring' that takes care of
different transformations for the code sent to be evaluated in
@@ -3094,9 +3133,16 @@ the python shell:
4. Wraps indented regions under an \"if True:\" block so the
interpreter evaluates them correctly."
(let* ((start (save-excursion
- ;; Normalize start to the line beginning position.
+ ;; If we're at the start of the expression, and
+ ;; there's just blank space ahead of it, then expand
+ ;; the region to include the start of the line.
+ ;; This makes things work better with the rest of
+ ;; the data we're sending over.
(goto-char start)
- (line-beginning-position)))
+ (if (string-blank-p
+ (buffer-substring (line-beginning-position) start))
+ (line-beginning-position)
+ start)))
(substring (buffer-substring-no-properties start end))
(starts-at-point-min-p (save-restriction
(widen)
@@ -3106,12 +3152,13 @@ the python shell:
(goto-char start)
(python-util-forward-comment 1)
(current-indentation))))
- (fillstr (when (not starts-at-point-min-p)
- (concat
- (format "# -*- coding: %s -*-\n" encoding)
- (make-string
- ;; Subtract 2 because of the coding cookie.
- (- (line-number-at-pos start) 2) ?\n)))))
+ (fillstr (and (not no-cookie)
+ (not starts-at-point-min-p)
+ (concat
+ (format "# -*- coding: %s -*-\n" encoding)
+ (make-string
+ ;; Subtract 2 because of the coding cookie.
+ (- (line-number-at-pos start) 2) ?\n)))))
(with-temp-buffer
(python-mode)
(when fillstr
@@ -3150,7 +3197,8 @@ the python shell:
(line-beginning-position) (line-end-position))))
(buffer-substring-no-properties (point-min) (point-max)))))
-(defun python-shell-send-region (start end &optional send-main msg)
+(defun python-shell-send-region (start end &optional send-main msg
+ no-cookie)
"Send the region delimited by START and END to inferior Python process.
When optional argument SEND-MAIN is non-nil, allow execution of
code inside blocks delimited by \"if __name__== \\='__main__\\=':\".
@@ -3160,7 +3208,8 @@ non-nil, forces display of a user-friendly message if there's no
process running; defaults to t when called interactively."
(interactive
(list (region-beginning) (region-end) current-prefix-arg t))
- (let* ((string (python-shell-buffer-substring start end (not send-main)))
+ (let* ((string (python-shell-buffer-substring start end (not send-main)
+ no-cookie))
(process (python-shell-get-process-or-error msg))
(original-string (buffer-substring-no-properties start end))
(_ (string-match "\\`\n*\\(.*\\)" original-string)))
@@ -3184,7 +3233,7 @@ interactively."
(python-shell-send-region
(save-excursion (python-nav-beginning-of-statement))
(save-excursion (python-nav-end-of-statement))
- send-main msg)))
+ send-main msg t)))
(defun python-shell-send-buffer (&optional send-main msg)
"Send the entire buffer to inferior Python process.
@@ -3206,27 +3255,29 @@ optional argument MSG is non-nil, forces display of a
user-friendly message if there's no process running; defaults to
t when called interactively."
(interactive (list current-prefix-arg t))
- (save-excursion
- (python-shell-send-region
- (progn
- (end-of-line 1)
- (while (and (or (python-nav-beginning-of-defun)
- (beginning-of-line 1))
- (> (current-indentation) 0)))
- (when (not arg)
- (while (and
- (eq (forward-line -1) 0)
- (if (looking-at (python-rx decorator))
- t
- (forward-line 1)
- nil))))
- (point-marker))
- (progn
- (or (python-nav-end-of-defun)
- (end-of-line 1))
- (point-marker))
- nil ;; noop
- msg)))
+ (let ((starting-pos (point)))
+ (save-excursion
+ (python-shell-send-region
+ (progn
+ (end-of-line 1)
+ (while (and (or (python-nav-beginning-of-defun)
+ (beginning-of-line 1))
+ (> (current-indentation) 0)))
+ (when (not arg)
+ (while (and
+ (eq (forward-line -1) 0)
+ (if (looking-at (python-rx decorator))
+ t
+ (forward-line 1)
+ nil))))
+ (point-marker))
+ (progn
+ (goto-char starting-pos)
+ (or (python-nav-end-of-defun)
+ (end-of-line 1))
+ (point-marker))
+ nil ;; noop
+ msg))))
(defun python-shell-send-file (file-name &optional process temp-file-name
delete msg)
@@ -3787,7 +3838,7 @@ the top stack frame has been reached.
Filename is expected in the first parenthesized expression.
Line number is expected in the second parenthesized expression."
- :type 'string
+ :type 'regexp
:version "27.1"
:safe 'stringp)
@@ -3802,7 +3853,7 @@ was `continue'. This behavior slightly differentiates the `continue' command
from the `exit' command listed in `python-pdbtrack-exit-command'.
See `python-pdbtrack-activate' for pdbtracking session overview."
- :type 'list
+ :type '(repeat string)
:version "27.1")
(defcustom python-pdbtrack-exit-command '("q" "quit" "exit")
@@ -3811,7 +3862,7 @@ After one of this commands is sent to pdb, pdbtracking session is
considered over.
See `python-pdbtrack-activate' for pdbtracking session overview."
- :type 'list
+ :type '(repeat string)
:version "27.1")
(defcustom python-pdbtrack-kill-buffers t
@@ -3954,8 +4005,8 @@ Argument OUTPUT is a string with the output from the comint process."
"Setup pdb tracking in current buffer."
(make-local-variable 'python-pdbtrack-buffers-to-kill)
(make-local-variable 'python-pdbtrack-tracked-buffer)
- (add-to-list (make-local-variable 'comint-input-filter-functions)
- #'python-pdbtrack-comint-input-filter-function)
+ (add-hook 'comint-input-filter-functions
+ #'python-pdbtrack-comint-input-filter-function nil t)
(add-to-list (make-local-variable 'comint-output-filter-functions)
#'python-pdbtrack-comint-output-filter-function)
(add-function :before (process-sentinel (get-buffer-process (current-buffer)))
@@ -4136,7 +4187,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
(goto-char (point-max)))
(point-marker)))
(multi-line-p
- ;; Docstring styles may vary for oneliners and multi-liners.
+ ;; Docstring styles may vary for one-liners and multi-liners.
(> (count-matches "\n" str-start-pos str-end-pos) 0))
(delimiters-style
(pcase python-fill-docstring-style
@@ -4562,7 +4613,7 @@ returns will be used. If not FORCE-PROCESS is passed what
:type 'boolean
:version "25.1")
-(defun python-eldoc-function ()
+(defun python-eldoc-function (&rest _ignored)
"`eldoc-documentation-function' for Python.
For this to work as best as possible you should call
`python-shell-send-buffer' from time to time so context in
@@ -4591,9 +4642,7 @@ Interactively, prompt for symbol."
(interactive
(let ((symbol (python-eldoc--get-symbol-at-point))
(enable-recursive-minibuffers t))
- (list (read-string (if symbol
- (format "Describe symbol (default %s): " symbol)
- "Describe symbol: ")
+ (list (read-string (format-prompt "Describe symbol" symbol)
nil nil symbol))))
(message (python-eldoc--get-doc-at-point symbol)))
@@ -5137,21 +5186,22 @@ point's current `syntax-ppss'."
(>=
2
(let (last-backward-sexp-point)
- (while (save-excursion
- (python-nav-backward-sexp)
- (setq backward-sexp-point (point))
- (and (= indentation (current-indentation))
- ;; Make sure we're always moving point.
- ;; If we get stuck in the same position
- ;; on consecutive loop iterations,
- ;; bail out.
- (prog1 (not (eql last-backward-sexp-point
- backward-sexp-point))
- (setq last-backward-sexp-point
- backward-sexp-point))
- (looking-at-p
- (concat "[uU]?[rR]?"
- (python-rx string-delimiter)))))
+ (while (and (<= counter 2)
+ (save-excursion
+ (python-nav-backward-sexp)
+ (setq backward-sexp-point (point))
+ (and (= indentation (current-indentation))
+ ;; Make sure we're always moving point.
+ ;; If we get stuck in the same position
+ ;; on consecutive loop iterations,
+ ;; bail out.
+ (prog1 (not (eql last-backward-sexp-point
+ backward-sexp-point))
+ (setq last-backward-sexp-point
+ backward-sexp-point))
+ (looking-at-p
+ (concat "[uU]?[rR]?"
+ (python-rx string-delimiter))))))
;; Previous sexp was a string, restore point.
(goto-char backward-sexp-point)
(cl-incf counter))
@@ -5343,7 +5393,7 @@ To use `flake8' you would set this to (\"flake8\" \"-\")."
:group 'python-flymake
:type '(repeat string))
-;; The default regexp accomodates for older pyflakes, which did not
+;; The default regexp accommodates for older pyflakes, which did not
;; report the column number, and at the same time it's compatible with
;; flake8 output, although it may be redefined to explicitly match the
;; TYPE
@@ -5542,12 +5592,16 @@ REPORT-FN is Flymake's callback function."
(current-column))))
(^ '(- (1+ (current-indentation))))))
- (if (null eldoc-documentation-function)
- ;; Emacs<25
- (set (make-local-variable 'eldoc-documentation-function)
- #'python-eldoc-function)
- (add-function :before-until (local 'eldoc-documentation-function)
- #'python-eldoc-function))
+ (with-no-warnings
+ ;; suppress warnings about eldoc-documentation-function being obsolete
+ (if (null eldoc-documentation-function)
+ ;; Emacs<25
+ (set (make-local-variable 'eldoc-documentation-function)
+ #'python-eldoc-function)
+ (if (boundp 'eldoc-documentation-functions)
+ (add-hook 'eldoc-documentation-functions #'python-eldoc-function nil t)
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'python-eldoc-function))))
(add-to-list
'hs-special-modes-alist
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 5da5577c108..fbc6e424eb1 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -4,7 +4,7 @@
;; Authors: Yukihiro Matsumoto
;; Nobuyoshi Nakada
-;; URL: http://www.emacswiki.org/cgi-bin/wiki/RubyMode
+;; URL: https://www.emacswiki.org/cgi-bin/wiki/RubyMode
;; Created: Fri Feb 4 14:49:13 JST 1994
;; Keywords: languages ruby
;; Version: 1.2
@@ -28,13 +28,6 @@
;; Provides font-locking, indentation support, and navigation for Ruby code.
;;
-;; If you're installing manually, you should add this to your .emacs
-;; file after putting it on your load path:
-;;
-;; (autoload 'ruby-mode "ruby-mode" "Major mode for ruby files" t)
-;; (add-to-list 'auto-mode-alist '("\\.rb\\'" . ruby-mode))
-;; (add-to-list 'interpreter-mode-alist '("ruby" . ruby-mode))
-;;
;; Still needs more docstrings; search below for TODO.
;;; Code:
@@ -142,12 +135,11 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
"Regexp to match symbols.")
(defvar ruby-use-smie t)
+(make-obsolete-variable 'ruby-use-smie nil "28.1")
(defvar ruby-mode-map
(let ((map (make-sparse-keymap)))
(unless ruby-use-smie
- (define-key map (kbd "M-C-b") 'ruby-backward-sexp)
- (define-key map (kbd "M-C-f") 'ruby-forward-sexp)
(define-key map (kbd "M-C-q") 'ruby-indent-exp))
(when ruby-use-smie
(define-key map (kbd "M-C-d") 'smie-down-list))
@@ -170,14 +162,8 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
"--"
["Toggle String Quotes" ruby-toggle-string-quotes t]
"--"
- ["Backward Sexp" ruby-backward-sexp
- :visible (not ruby-use-smie)]
- ["Backward Sexp" backward-sexp
- :visible ruby-use-smie]
- ["Forward Sexp" ruby-forward-sexp
- :visible (not ruby-use-smie)]
- ["Forward Sexp" forward-sexp
- :visible ruby-use-smie]
+ ["Backward Sexp" backward-sexp t]
+ ["Forward Sexp" forward-sexp t]
["Indent Sexp" ruby-indent-exp
:visible (not ruby-use-smie)]
["Indent Sexp" prog-indent-sexp
@@ -741,10 +727,10 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
(defun ruby-mode-variables ()
"Set up initial buffer-local variables for Ruby mode."
(setq indent-tabs-mode ruby-indent-tabs-mode)
- (if ruby-use-smie
- (smie-setup ruby-smie-grammar #'ruby-smie-rules
- :forward-token #'ruby-smie--forward-token
- :backward-token #'ruby-smie--backward-token)
+ (smie-setup ruby-smie-grammar #'ruby-smie-rules
+ :forward-token #'ruby-smie--forward-token
+ :backward-token #'ruby-smie--backward-token)
+ (unless ruby-use-smie
(setq-local indent-line-function #'ruby-indent-line))
(setq-local comment-start "# ")
(setq-local comment-end "")
@@ -801,7 +787,7 @@ The style of the comment is controlled by `ruby-encoding-magic-comment-style'."
(let ((coding-system (ruby--detect-encoding)))
(when coding-system
(if (looking-at "^#!") (beginning-of-line 2))
- (cond ((looking-at "\\s *#\\s *.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)")
+ (cond ((looking-at "\\s *#.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)")
;; update existing encoding comment if necessary
(unless (string= (match-string 2) coding-system)
(goto-char (match-beginning 2))
@@ -1060,22 +1046,12 @@ delimiter."
(goto-char (point))
)
((looking-at "[\\[{(]")
- (let ((deep (ruby-deep-indent-paren-p (char-after))))
- (if (and deep (or (not (eq (char-after) ?\{)) (ruby-expr-beg)))
- (progn
- (and (eq deep 'space) (looking-at ".\\s +[^# \t\n]")
- (setq pnt (1- (match-end 0))))
- (setq nest (cons (cons (char-after (point)) pnt) nest))
- (setq pcol (cons (cons pnt depth) pcol))
- (setq depth 0))
- (setq nest (cons (cons (char-after (point)) pnt) nest))
- (setq depth (1+ depth))))
+ (setq nest (cons (cons (char-after (point)) pnt) nest))
+ (setq depth (1+ depth))
(goto-char pnt)
)
((looking-at "[])}]")
- (if (ruby-deep-indent-paren-p (matching-paren (char-after)))
- (setq depth (cdr (car pcol)) pcol (cdr pcol))
- (setq depth (1- depth)))
+ (setq depth (1- depth))
(setq nest (cdr nest))
(goto-char pnt))
((looking-at ruby-block-end-re)
@@ -1388,7 +1364,8 @@ move forward."
The defun begins at or after the point. This function is called
by `end-of-defun'."
(interactive "p")
- (ruby-forward-sexp)
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (ruby-forward-sexp))
(let (case-fold-search)
(when (looking-back (concat "^\\s *" ruby-block-end-re)
(line-beginning-position))
@@ -1477,11 +1454,14 @@ With ARG, move out of multiple blocks."
(defun ruby-forward-sexp (&optional arg)
"Move forward across one balanced expression (sexp).
With ARG, do it many times. Negative ARG means move backward."
+ (declare (obsolete forward-sexp "28.1"))
;; TODO: Document body
(interactive "p")
(cond
(ruby-use-smie (forward-sexp arg))
- ((and (numberp arg) (< arg 0)) (ruby-backward-sexp (- arg)))
+ ((and (numberp arg) (< arg 0))
+ (with-suppressed-warnings ((obsolete ruby-backward-sexp))
+ (ruby-backward-sexp (- arg))))
(t
(let ((i (or arg 1)))
(condition-case nil
@@ -1525,11 +1505,14 @@ With ARG, do it many times. Negative ARG means move backward."
(defun ruby-backward-sexp (&optional arg)
"Move backward across one balanced expression (sexp).
With ARG, do it many times. Negative ARG means move forward."
+ (declare (obsolete backward-sexp "28.1"))
;; TODO: Document body
(interactive "p")
(cond
(ruby-use-smie (backward-sexp arg))
- ((and (numberp arg) (< arg 0)) (ruby-forward-sexp (- arg)))
+ ((and (numberp arg) (< arg 0))
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (ruby-forward-sexp (- arg))))
(t
(let ((i (or arg 1)))
(condition-case nil
@@ -1681,7 +1664,8 @@ See `add-log-current-defun-function'."
(defun ruby-block-contains-point (pt)
(save-excursion
(save-match-data
- (ruby-forward-sexp)
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (ruby-forward-sexp))
(> (point) pt))))
(defun ruby-brace-to-do-end (orig end)
@@ -1759,7 +1743,8 @@ If the result is do-end block, it will always be multiline."
(progn
(goto-char (or (match-beginning 1) (match-beginning 2)))
(setq beg (point))
- (save-match-data (ruby-forward-sexp))
+ (with-suppressed-warnings ((obsolete ruby-forward-sexp))
+ (save-match-data (ruby-forward-sexp)))
(setq end (point))
(> end start)))
(if (match-beginning 1)
@@ -2444,7 +2429,7 @@ If there is no Rubocop config file, Rubocop will be passed a flag
"\\)"
"\\|/"
"\\(?:Gem\\|Rake\\|Cap\\|Thor"
- "\\|Puppet\\|Berks"
+ "\\|Puppet\\|Berks\\|Brew"
"\\|Vagrant\\|Guard\\|Pod\\)file"
"\\)\\'"))
'ruby-mode))
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 751d7da5427..33ba0d11d80 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -116,7 +116,7 @@
(defvar scheme-imenu-generic-expression
'((nil
- "^(define\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)*\\s-+(?\\(\\sw+\\)" 4)
+ "^(define\\(?:-\\(?:generic\\(?:-procedure\\)?\\|method\\)\\)?\\s-+(?\\(\\sw+\\)" 1)
("Types"
"^(define-class\\s-+(?\\(\\sw+\\)" 1)
("Macros"
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index cc6d5b46ed2..3b24cabe8bd 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -4,7 +4,7 @@
;; Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
-;; Version: 2.0f
+;; Old-Version: 2.0f
;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, unix
@@ -64,61 +64,10 @@
;; * Indent right half sh-basic-offset
;; / Indent left half sh-basic-offset.
;;
-;; There are 4 commands to help set the indentation variables:
-;;
-;; `sh-show-indent'
-;; This shows what variable controls the indentation of the current
-;; line and its value.
-;;
-;; `sh-set-indent'
-;; This allows you to set the value of the variable controlling the
-;; current line's indentation. You can enter a number or one of a
-;; number of special symbols to denote the value of sh-basic-offset,
-;; or its negative, or half it, or twice it, etc. If you've used
-;; cc-mode this should be familiar. If you forget which symbols are
-;; valid simply press C-h at the prompt.
-;;
-;; `sh-learn-line-indent'
-;; Simply make the line look the way you want it, then invoke this
-;; command. It will set the variable to the value that makes the line
-;; indent like that. If called with a prefix argument then it will set
-;; the value to one of the symbols if applicable.
-;;
-;; `sh-learn-buffer-indent'
-;; This is the deluxe function! It "learns" the whole buffer (use
-;; narrowing if you want it to process only part). It outputs to a
-;; buffer *indent* any conflicts it finds, and all the variables it has
-;; learned. This buffer is a sort of Occur mode buffer, allowing you to
-;; easily find where something was set. It is popped to automatically
-;; if there are any conflicts found or if `sh-popup-occur-buffer' is
-;; non-nil.
-;; `sh-indent-comment' will be set if all comments follow the same
-;; pattern; if they don't it will be set to nil.
-;; Whether `sh-basic-offset' is set is determined by variable
-;; `sh-learn-basic-offset'.
-;;
-;; Unfortunately, `sh-learn-buffer-indent' can take a long time to run
-;; (e.g. if there are large case statements). Perhaps it does not make
-;; sense to run it on large buffers: if lots of lines have different
-;; indentation styles it will produce a lot of diagnostics in the
-;; *indent* buffer; if there is a consistent style then running
-;; `sh-learn-buffer-indent' on a small region of the buffer should
-;; suffice.
-;;
;; Saving indentation values
;; -------------------------
-;; After you've learned the values in a buffer, how to you remember
-;; them? Originally I had hoped that `sh-learn-buffer-indent'
-;; would make this unnecessary; simply learn the values when you visit
-;; the buffer.
-;; You can do this automatically like this:
-;; (add-hook 'sh-set-shell-hook #'sh-learn-buffer-indent)
-;;
-;; However... `sh-learn-buffer-indent' is extremely slow,
-;; especially on large-ish buffer. Also, if there are conflicts the
-;; "last one wins" which may not produce the desired setting.
-;;
-;; So...There is a minimal way of being able to save indentation values and
+;; After you've learned the values in a buffer, how to you remember them?
+;; There is a minimal way of being able to save indentation values and
;; to reload them in another buffer or at another point in time.
;;
;; Use `sh-name-style' to give a name to the indentation settings of
@@ -132,7 +81,7 @@
;; Indentation variables - buffer local or global?
;; ----------------------------------------------
;; I think that often having them buffer-local makes sense,
-;; especially if one is using `sh-learn-buffer-indent'. However, if
+;; especially if one is using `smie-config-guess'. However, if
;; a user sets values using customization, these changes won't appear
;; to work if the variables are already local!
;;
@@ -175,18 +124,10 @@
;; - Indenting many lines is slow. It currently does each line
;; independently, rather than saving state information.
;;
-;; - `sh-learn-buffer-indent' is extremely slow.
-;;
-;; - "case $x in y) echo ;; esac)" the last ) is mis-identified as being
-;; part of a case-pattern. You need to add a semi-colon after "esac" to
-;; coerce sh-script into doing the right thing.
-;;
;; - "echo $z in ps | head)" the last ) is mis-identified as being part of
;; a case-pattern. You need to put the "in" between quotes to coerce
;; sh-script into doing the right thing.
;;
-;; - A line starting with "}>foo" is not indented like "} >foo".
-;;
;; Richard Sharman <rsharman@pobox.com> June 1999.
;;; Code:
@@ -445,6 +386,7 @@ name symbol."
?~ "_"
?, "_"
?= "."
+ ?/ "."
?\; "."
?| "."
?& "."
@@ -474,10 +416,10 @@ This is buffer-local in every such buffer.")
(define-key map "\C-c\C-i" 'sh-if)
(define-key map "\C-c\C-f" 'sh-for)
(define-key map "\C-c\C-c" 'sh-case)
- (define-key map "\C-c?" 'sh-show-indent)
- (define-key map "\C-c=" 'sh-set-indent)
- (define-key map "\C-c<" 'sh-learn-line-indent)
- (define-key map "\C-c>" 'sh-learn-buffer-indent)
+ (define-key map "\C-c?" #'smie-config-show-indent)
+ (define-key map "\C-c=" #'smie-config-set-indent)
+ (define-key map "\C-c<" #'smie-config-set-indent)
+ (define-key map "\C-c>" #'smie-config-guess)
(define-key map "\C-c\C-\\" 'sh-backslash-region)
(define-key map "\C-c+" 'sh-add)
@@ -493,17 +435,14 @@ This is buffer-local in every such buffer.")
(define-key map [remap backward-sentence] 'sh-beginning-of-command)
(define-key map [remap forward-sentence] 'sh-end-of-command)
(define-key map [menu-bar sh-script] (cons "Sh-Script" menu-map))
- (define-key menu-map [sh-learn-buffer-indent]
- '(menu-item "Learn buffer indentation" sh-learn-buffer-indent
+ (define-key menu-map [smie-config-guess]
+ '(menu-item "Learn buffer indentation" smie-config-guess
:help "Learn how to indent the buffer the way it currently is."))
- (define-key menu-map [sh-learn-line-indent]
- '(menu-item "Learn line indentation" sh-learn-line-indent
- :help "Learn how to indent a line as it currently is indented"))
- (define-key menu-map [sh-show-indent]
- '(menu-item "Show indentation" sh-show-indent
+ (define-key menu-map [smie-config-show-indent]
+ '(menu-item "Show indentation" smie-config-show-indent
:help "Show the how the current line would be indented"))
- (define-key menu-map [sh-set-indent]
- '(menu-item "Set indentation" sh-set-indent
+ (define-key menu-map [smie-config-set-indent]
+ '(menu-item "Set indentation" smie-config-set-indent
:help "Set the indentation for the current line"))
(define-key menu-map [sh-pair]
@@ -900,7 +839,7 @@ See `sh-feature'.")
font-lock-variable-name-face))
(rc sh-append es)
- (bash sh-append sh ("\\$(\\(\\sw+\\)" (1 'sh-quoted-exec t) ))
+ (bash sh-append sh ("\\$(\\([^)\n]+\\)" (1 'sh-quoted-exec t) ))
(sh sh-append shell
;; Variable names.
("\\$\\({#?\\)?\\([[:alpha:]_][[:alnum:]_]*\\|[-#?@!]\\)" 2
@@ -1158,7 +1097,7 @@ subshells can nest."
(")" (0 (sh-font-lock-paren (match-beginning 0))))
;; Highlight (possibly nested) subshells inside "" quoted
;; regions correctly.
- ("\"\\(?:\\(?:[^\\\"]\\|\\\\.\\)*?\\)??\\(\\$(\\|`\\)"
+ ("\"\\(?:[^\\\"]\\|\\\\.\\)*?\\(\\$(\\|`\\)"
(1 (ignore
(if (nth 8 (save-excursion (syntax-ppss (match-beginning 0))))
(goto-char (1+ (match-beginning 0)))
@@ -1196,20 +1135,8 @@ and command `sh-reset-indent-vars-to-global-values'."
:options '(sh-electric-here-document-mode)
:group 'sh-script)
-(defcustom sh-learn-basic-offset nil
- "When `sh-guess-basic-offset' should learn `sh-basic-offset'.
-
-nil mean: never.
-t means: only if there seems to be an obvious value.
-Anything else means: whenever we have a \"good guess\" as to the value."
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "Only if sure" t)
- (const :tag "If have a good guess" usually))
- :group 'sh-indentation)
-
(defcustom sh-popup-occur-buffer nil
- "Controls when `sh-learn-buffer-indent' pops the `*indent*' buffer.
+ "Controls when `smie-config-guess' pops the `*indent*' buffer.
If t it is always shown. If nil, it is shown only when there
are conflicts."
:type '(choice
@@ -1217,14 +1144,6 @@ are conflicts."
(const :tag "Always" t))
:group 'sh-indentation)
-(defcustom sh-blink t
- "If non-nil, `sh-show-indent' shows the line indentation is relative to.
-The position on the line is not necessarily meaningful.
-In some cases the line will be the matching keyword, but this is not
-always the case."
- :type 'boolean
- :group 'sh-indentation)
-
(defcustom sh-first-lines-indent 0
"The indentation of the first non-blank non-comment line.
Usually 0 meaning first column.
@@ -1567,11 +1486,9 @@ following commands are available, based on the current shell's syntax:
\\[sh-while] while loop
For sh and rc shells indentation commands are:
-\\[sh-show-indent] Show the variable controlling this line's indentation.
-\\[sh-set-indent] Set then variable controlling this line's indentation.
-\\[sh-learn-line-indent] Change the indentation variable so this line
-would indent to the way it currently is.
-\\[sh-learn-buffer-indent] Set the indentation variables so the
+\\[smie-config-show-indent] Show the rules controlling this line's indentation.
+\\[smie-config-set-indent] Change the rules controlling this line's indentation.
+\\[smie-config-guess] Try to tweak the indentation rules so the
buffer indents as it currently is indented.
@@ -1738,13 +1655,6 @@ This adds rules for comments and assignments."
(require 'smie)
-;; The SMIE code should generally be preferred, but it currently does not obey
-;; the various indentation custom-vars, and it misses some important features
-;; of the old code, mostly: sh-learn-line/buffer-indent, sh-show-indent,
-;; sh-name/save/load-style.
-(defvar sh-use-smie t
- "Whether to use the SMIE code for navigation and indentation.")
-
(defun sh-smie--keyword-p ()
"Non-nil if we're at a keyword position.
A keyword position is one where if we're looking at something that looks
@@ -2279,60 +2189,6 @@ Point should be before the newline."
(defvar sh-regexp-for-done nil
"A buffer-local regexp to match opening keyword for done.")
-(defvar sh-kw-alist nil
- "A buffer-local, since it is shell-type dependent, list of keywords.")
-
-;; ( key-word first-on-this on-prev-line )
-;; This is used to set `sh-kw-alist' which is a list of sublists each
-;; having 3 elements:
-;; a keyword
-;; a rule to check when the keyword appears on "this" line
-;; a rule to check when the keyword appears on "the previous" line
-;; The keyword is usually a string and is the first word on a line.
-;; If this keyword appears on the line whose indentation is to be
-;; calculated, the rule in element 2 is called. If this returns
-;; non-zero, the resulting point (which may be changed by the rule)
-;; is used as the default indentation.
-;; If it returned false or the keyword was not found in the table,
-;; then the keyword from the previous line is looked up and the rule
-;; in element 3 is called. In this case, however,
-;; `sh-get-indent-info' does not stop but may keep going and test
-;; other keywords against rules in element 3. This is because the
-;; preceding line could have, for example, an opening "if" and an
-;; opening "while" keyword and we need to add the indentation offsets
-;; for both.
-;;
-(defconst sh-kw
- '((sh
- ("if" nil sh-handle-prev-if)
- ("elif" sh-handle-this-else sh-handle-prev-else)
- ("else" sh-handle-this-else sh-handle-prev-else)
- ("fi" sh-handle-this-fi sh-handle-prev-fi)
- ("then" sh-handle-this-then sh-handle-prev-then)
- ("(" nil sh-handle-prev-open)
- ("{" nil sh-handle-prev-open)
- ("[" nil sh-handle-prev-open)
- ("}" sh-handle-this-close nil)
- (")" sh-handle-this-close nil)
- ("]" sh-handle-this-close nil)
- ("case" nil sh-handle-prev-case)
- ("esac" sh-handle-this-esac sh-handle-prev-esac)
- (case-label nil sh-handle-after-case-label) ;; ???
- (";;" nil sh-handle-prev-case-alt-end) ;; ???
- (";;&" nil sh-handle-prev-case-alt-end) ;Like ";;" with diff semantics.
- (";&" nil sh-handle-prev-case-alt-end) ;Like ";;" with diff semantics.
- ("done" sh-handle-this-done sh-handle-prev-done)
- ("do" sh-handle-this-do sh-handle-prev-do))
-
- ;; Note: we don't need specific stuff for bash and zsh shells;
- ;; the regexp `sh-regexp-for-done' handles the extra keywords
- ;; these shells use.
- (rc
- ("{" nil sh-handle-prev-open)
- ("}" sh-handle-this-close nil)
- ("case" sh-handle-this-rc-case sh-handle-prev-rc-case))))
-
-
(defun sh-set-shell (shell &optional no-query-flag insert-flag)
"Set this buffer's shell to SHELL (a string).
@@ -2351,8 +2207,7 @@ Shell script files can cause this function be called automatically
when the file is visited by having a `sh-shell' file-local variable
whose value is the shell name (don't quote it)."
(interactive (list (completing-read
- (format "Shell (default %s): "
- sh-shell-file)
+ (format-prompt "Shell" sh-shell-file)
;; This used to use interpreter-mode-alist, but that is
;; no longer appropriate now that uses regexps.
;; Maybe there could be a separate variable that lists
@@ -2400,16 +2255,6 @@ whose value is the shell name (don't quote it)."
(funcall mksym "rules")
:forward-token (funcall mksym "forward-token")
:backward-token (funcall mksym "backward-token")))
- (unless sh-use-smie
- (setq-local sh-kw-alist (sh-feature sh-kw))
- (let ((regexp (sh-feature sh-kws-for-done)))
- (if regexp
- (setq-local sh-regexp-for-done
- (sh-mkword-regexpr (regexp-opt regexp t)))))
- (message "setting up indent stuff")
- ;; sh-mode has already made indent-line-function local
- ;; but do it in case this is called before that.
- (setq-local indent-line-function #'sh-indent-line))
(if sh-make-vars-local
(sh-make-vars-local))
(message "Indentation setup for shell type %s" sh-shell))
@@ -2564,11 +2409,6 @@ region, clear header."
(eq -1 (% (save-excursion (skip-chars-backward "\\\\")) 2)))
;; Indentation stuff.
-(defun sh-must-support-indent ()
- "Signal an error if the shell type for this buffer is not supported.
-Also, the buffer must be in Shell-script mode."
- (unless sh-indent-supported-here
- (error "This buffer's shell does not support indentation through Emacs")))
(defun sh-make-vars-local ()
"Make the indentation variables local to this buffer.
@@ -2589,654 +2429,12 @@ Then, if variable `sh-make-vars-local' is non-nil, make them local."
(if sh-make-vars-local
(mapcar 'make-local-variable sh-var-list)))
-
-;; Theoretically these are only needed in shell and derived modes.
-;; However, the routines which use them are only called in those modes.
-(defconst sh-special-keywords "then\\|do")
-
-(defun sh-help-string-for-variable (var)
- "Construct a string for `sh-read-variable' when changing variable VAR ."
- (let ((msg (documentation-property var 'variable-documentation))
- (msg2 ""))
- (unless (memq var '(sh-first-lines-indent sh-indent-comment))
- (setq msg2
- (format "\n
-You can enter a number (positive to increase indentation,
-negative to decrease indentation, zero for no change to indentation).
-
-Or, you can enter one of the following symbols which are relative to
-the value of variable `sh-basic-offset'
-which in this buffer is currently %s.
-
-\t%s."
- sh-basic-offset
- (mapconcat (lambda (x)
- (nth (1- (length x)) x))
- sh-symbol-list "\n\t"))))
- (concat
- ;; The following shows the global not the local value!
- ;; (format "Current value of %s is %s\n\n" var (symbol-value var))
- msg msg2)))
-
-(defun sh-read-variable (var)
- "Read a new value for indentation variable VAR."
- (let ((minibuffer-help-form `(sh-help-string-for-variable
- (quote ,var)))
- val)
- (setq val (read-from-minibuffer
- (format "New value for %s (press %s for help): "
- var (single-key-description help-char))
- (format "%s" (symbol-value var))
- nil t))
- val))
-
-
-
(defun sh-in-comment-or-string (start)
"Return non-nil if START is in a comment or string."
(save-excursion
(let ((state (syntax-ppss start)))
(or (nth 3 state) (nth 4 state)))))
-(defun sh-goto-matching-if ()
- "Go to the matching if for a fi.
-This handles nested if..fi pairs."
- (let ((found (sh-find-prev-matching "\\bif\\b" "\\bfi\\b" 1)))
- (if found
- (goto-char found))))
-
-
-;; Functions named sh-handle-this-XXX are called when the keyword on the
-;; line whose indentation is being handled contain XXX;
-;; those named sh-handle-prev-XXX are when XXX appears on the previous line.
-
-(defun sh-handle-prev-if ()
- (list '(+ sh-indent-after-if)))
-
-(defun sh-handle-this-else ()
- (if (sh-goto-matching-if)
- ;; (list "aligned to if")
- (list "aligned to if" '(+ sh-indent-for-else))
- nil
- ))
-
-(defun sh-handle-prev-else ()
- (if (sh-goto-matching-if)
- (list '(+ sh-indent-after-if))
- ))
-
-(defun sh-handle-this-fi ()
- (if (sh-goto-matching-if)
- (list "aligned to if" '(+ sh-indent-for-fi))
- nil
- ))
-
-(defun sh-handle-prev-fi ()
- ;; Why do we have this rule? Because we must go back to the if
- ;; to get its indent. We may continue back from there.
- ;; We return nil because we don't have anything to add to result,
- ;; the side affect of setting align-point is all that matters.
- ;; we could return a comment (a string) but I can't think of a good one...
- (sh-goto-matching-if)
- nil)
-
-(defun sh-handle-this-then ()
- (let ((p (sh-goto-matching-if)))
- (if p
- (list '(+ sh-indent-for-then))
- )))
-
-(defun sh-handle-prev-then ()
- (let ((p (sh-goto-matching-if)))
- (if p
- (list '(+ sh-indent-after-if))
- )))
-
-(defun sh-handle-prev-open ()
- (save-excursion
- (let ((x (sh-prev-stmt)))
- (if (and x
- (progn
- (goto-char x)
- (or
- (looking-at "function\\b")
- (looking-at "\\s-*\\S-+\\s-*()")
- )))
- (list '(+ sh-indent-after-function))
- (list '(+ sh-indent-after-open)))
- )))
-
-(defun sh-handle-this-close ()
- (forward-char 1) ;; move over ")"
- (if (sh-safe-forward-sexp -1)
- (list "aligned to opening paren")))
-
-(defun sh-goto-matching-case ()
- (let ((found (sh-find-prev-matching "\\bcase\\b" "\\besac\\b" 1)))
- (if found (goto-char found))))
-
-(defun sh-handle-prev-case ()
- ;; This is typically called when point is on same line as a case
- ;; we shouldn't -- and can't find prev-case
- (if (looking-at ".*\\<case\\>")
- (list '(+ sh-indent-for-case-label))
- (error "We don't seem to be on a line with a case"))) ;; debug
-
-(defun sh-handle-this-esac ()
- (if (sh-goto-matching-case)
- (list "aligned to matching case")))
-
-(defun sh-handle-prev-esac ()
- (if (sh-goto-matching-case)
- (list "matching case")))
-
-(defun sh-handle-after-case-label ()
- (if (sh-goto-matching-case)
- (list '(+ sh-indent-for-case-alt))))
-
-(defun sh-handle-prev-case-alt-end ()
- (if (sh-goto-matching-case)
- (list '(+ sh-indent-for-case-label))))
-
-(defun sh-safe-forward-sexp (&optional arg)
- "Try and do a `forward-sexp', but do not error.
-Return new point if successful, nil if an error occurred."
- (condition-case nil
- (progn
- (forward-sexp (or arg 1))
- (point)) ;; return point if successful
- (error
- (sh-debug "oops!(1) %d" (point))
- nil))) ;; return nil if fail
-
-(defun sh-goto-match-for-done ()
- (let ((found (sh-find-prev-matching sh-regexp-for-done sh-re-done 1)))
- (if found
- (goto-char found))))
-
-(defun sh-handle-this-done ()
- (if (sh-goto-match-for-done)
- (list "aligned to do stmt" '(+ sh-indent-for-done))))
-
-(defun sh-handle-prev-done ()
- (if (sh-goto-match-for-done)
- (list "previous done")))
-
-(defun sh-handle-this-do ()
- (if (sh-goto-match-for-done)
- (list '(+ sh-indent-for-do))))
-
-(defun sh-handle-prev-do ()
- (cond
- ((save-restriction
- (narrow-to-region (point) (line-beginning-position))
- (sh-goto-match-for-done))
- (sh-debug "match for done found on THIS line")
- (list '(+ sh-indent-after-loop-construct)))
- ((sh-goto-match-for-done)
- (sh-debug "match for done found on PREV line")
- (list '(+ sh-indent-after-do)))
- (t
- (message "match for done NOT found")
- nil)))
-
-;; for rc:
-(defun sh-find-prev-switch ()
- "Find the line for the switch keyword matching this line's case keyword."
- (re-search-backward "\\<switch\\>" nil t))
-
-(defun sh-handle-this-rc-case ()
- (if (sh-find-prev-switch)
- (list '(+ sh-indent-after-switch))
- ;; (list '(+ sh-indent-for-case-label))
- nil))
-
-(defun sh-handle-prev-rc-case ()
- (list '(+ sh-indent-after-case)))
-
-(defun sh-check-rule (n thing)
- (let ((rule (nth n (assoc thing sh-kw-alist)))
- (val nil))
- (if rule
- (progn
- (setq val (funcall rule))
- (sh-debug "rule (%d) for %s at %d is %s\n-> returned %s"
- n thing (point) rule val)))
- val))
-
-
-(defun sh-get-indent-info ()
- "Return indent-info for this line.
-This is a list. nil means the line is to be left as is.
-Otherwise it contains one or more of the following sublists:
-\(t NUMBER) NUMBER is the base location in the buffer that indentation is
- relative to. If present, this is always the first of the
- sublists. The indentation of the line in question is
- derived from the indentation of this point, possibly
- modified by subsequent sublists.
-\(+ VAR)
-\(- VAR) Get the value of variable VAR and add to or subtract from
- the indentation calculated so far.
-\(= VAR) Get the value of variable VAR and *replace* the
- indentation with its value. This only occurs for
- special variables such as `sh-indent-comment'.
-STRING This is ignored for the purposes of calculating
- indentation, it is printed in certain cases to help show
- what the indentation is based on."
- ;; See comments before `sh-kw'.
- (save-excursion
- (let ((have-result nil)
- this-kw
- val
- (result nil)
- (align-point nil)
- prev-line-end x)
- (beginning-of-line)
- ;; Note: setting result to t means we are done and will return nil.
- ;;(This function never returns just t.)
- (cond
- ((or (nth 3 (syntax-ppss (point)))
- (eq (get-text-property (point) 'face) 'sh-heredoc))
- ;; String continuation -- don't indent
- (setq result t)
- (setq have-result t))
- ((looking-at "\\s-*#") ; was (equal this-kw "#")
- (if (bobp)
- (setq result t) ;; return nil if 1st line!
- (setq result (list '(= sh-indent-comment)))
- ;; we still need to get previous line in case
- ;; sh-indent-comment is t (indent as normal)
- (setq align-point (sh-prev-line nil))
- (setq have-result nil)
- ))
- ) ;; cond
-
- (unless have-result
- ;; Continuation lines are handled specially
- (if (sh-this-is-a-continuation)
- (progn
- (setq result
- (if (save-excursion
- (beginning-of-line)
- (not (memq (char-before (- (point) 2)) '(?\s ?\t))))
- ;; By convention, if the continuation \ is not
- ;; preceded by a SPC or a TAB it means that the line
- ;; is cut at a place where spaces cannot be freely
- ;; added/removed. I.e. do not indent the line.
- (list '(= nil))
- ;; We assume the line being continued is already
- ;; properly indented...
- ;; (setq prev-line-end (sh-prev-line))
- (setq align-point (sh-prev-line nil))
- (list '(+ sh-indent-for-continuation))))
- (setq have-result t))
- (beginning-of-line)
- (skip-chars-forward " \t")
- (setq this-kw (sh-get-kw)))
-
- ;; Handle "this" keyword: first word on the line we're
- ;; calculating indentation info for.
- (if this-kw
- (if (setq val (sh-check-rule 1 this-kw))
- (progn
- (setq align-point (point))
- (sh-debug
- "this - setting align-point to %d" align-point)
- (setq result (append result val))
- (setq have-result t)
- ;; set prev-line to continue processing remainder
- ;; of this line as a previous line
- (setq prev-line-end (point))
- ))))
-
- (unless have-result
- (setq prev-line-end (sh-prev-line 'end)))
-
- (if prev-line-end
- (save-excursion
- ;; We start off at beginning of this line.
- ;; Scan previous statements while this is <=
- ;; start of previous line.
- (goto-char prev-line-end)
- (setq x t)
- (while (and x (setq x (sh-prev-thing)))
- (sh-debug "at %d x is: %s result is: %s" (point) x result)
- (cond
- ((and (equal x ")")
- (equal (get-text-property (1- (point)) 'syntax-table)
- sh-st-punc))
- (sh-debug "Case label) here")
- (setq x 'case-label)
- (if (setq val (sh-check-rule 2 x))
- (progn
- (setq result (append result val))
- (setq align-point (point))))
- (or (bobp)
- (forward-char -1))
- (skip-chars-forward "*0-9?[]a-z")
- )
- ((string-match "[])}]" x)
- (setq x (sh-safe-forward-sexp -1))
- (if x
- (progn
- (setq align-point (point))
- (setq result (append result
- (list "aligned to opening paren")))
- )))
- ((string-match "[[({]" x)
- (sh-debug "Checking special thing: %s" x)
- (if (setq val (sh-check-rule 2 x))
- (setq result (append result val)))
- (forward-char -1)
- (setq align-point (point)))
- ((string-match "[\"'`]" x)
- (sh-debug "Skipping back for %s" x)
- ;; this was oops-2
- (setq x (sh-safe-forward-sexp -1)))
- ((stringp x)
- (sh-debug "Checking string %s at %s" x (point))
- (if (setq val (sh-check-rule 2 x))
- ;; (or (eq t (car val))
- ;; (eq t (car (car val))))
- (setq result (append result val)))
- ;; not sure about this test Wed Jan 27 23:48:35 1999
- (setq align-point (point))
- (unless (bolp)
- (forward-char -1)))
- (t
- (error "Don't know what to do with %s" x))
- )
- ) ;; while
- (sh-debug "result is %s" result)
- )
- (sh-debug "No prev line!")
- (sh-debug "result: %s align-point: %s" result align-point)
- )
-
- (if align-point
- ;; was: (setq result (append result (list (list t align-point))))
- (setq result (append (list (list t align-point)) result))
- )
- (sh-debug "result is now: %s" result)
-
- (or result
- (setq result (list (if prev-line-end
- (list t prev-line-end)
- (list '= 'sh-first-lines-indent)))))
-
- (if (eq result t)
- (setq result nil))
- (sh-debug "result is: %s" result)
- result
- ) ;; let
- ))
-
-
-(defun sh-get-indent-var-for-line (&optional info)
- "Return the variable controlling indentation for this line.
-If there is not [just] one such variable, return a string
-indicating the problem.
-If INFO is supplied it is used, else it is calculated."
- (let ((var nil)
- (result nil)
- (reason nil)
- sym elt)
- (or info
- (setq info (sh-get-indent-info)))
- (if (null info)
- (setq result "this line to be left as is")
- (while (and info (null result))
- (setq elt (car info))
- (cond
- ((stringp elt)
- (setq reason elt)
- )
- ((not (listp elt))
- (error "sh-get-indent-var-for-line invalid elt: %s" elt))
- ;; so it is a list
- ((eq t (car elt))
- ) ;; nothing
- ((symbolp (setq sym (nth 1 elt)))
- ;; A bit of a kludge - when we see the sh-indent-comment
- ;; ignore other variables. Otherwise it is tricky to
- ;; "learn" the comment indentation.
- (if (eq var 'sh-indent-comment)
- (setq result var)
- (if var
- (setq result
- "this line is controlled by more than 1 variable.")
- (setq var sym))))
- (t
- (error "sh-get-indent-var-for-line invalid list elt: %s" elt)))
- (setq info (cdr info))
- ))
- (or result
- (setq result var))
- (or result
- (setq result reason))
- (if (null result)
- ;; e.g. just had (t POS)
- (setq result "line has default indentation"))
- result))
-
-
-
-;; Finding the previous line isn't trivial.
-;; We must *always* go back one more and see if that is a continuation
-;; line -- it is the PREVIOUS line which is continued, not the one
-;; we are going to!
-;; Also, we want to treat a whole "here document" as one big line,
-;; because we may want to align to the beginning of it.
-;;
-;; What we do:
-;; - go back to previous non-empty line
-;; - if this is in a here-document, go to the beginning of it
-;; - while previous line is continued, go back one line
-(defun sh-prev-line (&optional end)
- "Back to end of previous non-comment non-empty line.
-Go to beginning of logical line unless END is non-nil, in which case
-we go to the end of the previous line and do not check for continuations."
- (save-excursion
- (beginning-of-line)
- (forward-comment (- (point-max)))
- (unless end (beginning-of-line))
- (when (and (not (bobp))
- (eq (get-text-property (1- (point)) 'face) 'sh-heredoc))
- (let ((p1 (previous-single-property-change (1- (point)) 'face)))
- (when p1
- (goto-char p1)
- (if end
- (end-of-line)
- (beginning-of-line)))))
- (unless end
- ;; we must check previous lines to see if they are continuation lines
- ;; if so, we must return position of first of them
- (while (and (sh-this-is-a-continuation)
- (>= 0 (forward-line -1))))
- (beginning-of-line)
- (skip-chars-forward " \t"))
- (point)))
-
-
-(defun sh-prev-stmt ()
- "Return the address of the previous stmt or nil."
- ;; This is used when we are trying to find a matching keyword.
- ;; Searching backward for the keyword would certainly be quicker, but
- ;; it is hard to remove "false matches" -- such as if the keyword
- ;; appears in a string or quote. This way is slower, but (I think) safer.
- (interactive)
- (save-excursion
- (let ((going t)
- (start (point))
- (found nil)
- (prev nil))
- (skip-chars-backward " \t;|&({[")
- (while (and (not found)
- (not (bobp))
- going)
- ;; Do a backward-sexp if possible, else backup bit by bit...
- (if (sh-safe-forward-sexp -1)
- (progn
- (if (looking-at sh-special-keywords)
- (progn
- (setq found prev))
- (setq prev (point))
- ))
- ;; backward-sexp failed
- (if (zerop (skip-chars-backward " \t()[]{};`'"))
- (forward-char -1))
- (if (bolp)
- (let ((back (sh-prev-line nil)))
- (if back
- (goto-char back)
- (setq going nil)))))
- (unless found
- (skip-chars-backward " \t")
- (if (or (and (bolp) (not (sh-this-is-a-continuation)))
- (eq (char-before) ?\;)
- (looking-at "\\s-*[|&]"))
- (setq found (point)))))
- (if found
- (goto-char found))
- (if found
- (progn
- (skip-chars-forward " \t|&({[")
- (setq found (point))))
- (if (>= (point) start)
- (progn
- (debug "We didn't move!")
- (setq found nil))
- (or found
- (sh-debug "Did not find prev stmt.")))
- found)))
-
-
-(defun sh-get-word ()
- "Get a shell word skipping whitespace from point."
- (interactive)
- (skip-chars-forward "\t ")
- (let ((start (point)))
- (while
- (if (looking-at "[\"'`]")
- (sh-safe-forward-sexp)
- ;; (> (skip-chars-forward "^ \t\n\"'`") 0)
- (> (skip-chars-forward "-_$[:alnum:]") 0)
- ))
- (buffer-substring start (point))
- ))
-
-(defun sh-prev-thing ()
- "Return the previous thing this logical line."
- ;; This is called when `sh-get-indent-info' is working backwards on
- ;; the previous line(s) finding what keywords may be relevant for
- ;; indenting. It moves over sexps if possible, and will stop
- ;; on a ; and at the beginning of a line if it is not a continuation
- ;; line.
- ;;
- ;; Added a kludge for ";;"
- ;; Possible return values:
- ;; nil - nothing
- ;; a string - possibly a keyword
- ;;
- (if (bolp)
- nil
- (let ((start (point))
- (min-point (if (sh-this-is-a-continuation)
- (sh-prev-line nil)
- (line-beginning-position))))
- (skip-chars-backward " \t;" min-point)
- (if (looking-at "\\s-*;[;&]")
- ;; (message "Found ;; !")
- ";;"
- (skip-chars-backward "^)}];\"'`({[" min-point)
- (let ((c (if (> (point) min-point) (char-before))))
- (sh-debug "stopping at %d c is %s start=%d min-point=%d"
- (point) c start min-point)
- (if (not (memq c '(?\n nil ?\;)))
- ;; c -- return a string
- (char-to-string c)
- ;; Return the leading keyword of the "command" we supposedly
- ;; skipped over. Maybe we skipped too far (e.g. past a `do' or
- ;; `then' that precedes the actual command), so check whether
- ;; we're looking at such a keyword and if so, move back forward.
- (let ((boundary (point))
- kwd next)
- (while
- (progn
- ;; Skip forward over white space newline and \ at eol.
- (skip-chars-forward " \t\n\\\\" start)
- (if (>= (point) start)
- (progn
- (sh-debug "point: %d >= start: %d" (point) start)
- nil)
- (if next (setq boundary next))
- (sh-debug "Now at %d start=%d" (point) start)
- (setq kwd (sh-get-word))
- (if (member kwd (sh-feature sh-leading-keywords))
- (progn
- (setq next (point))
- t)
- nil))))
- (goto-char boundary)
- kwd)))))))
-
-
-(defun sh-this-is-a-continuation ()
- "Return non-nil if current line is a continuation of previous line."
- (save-excursion
- (and (zerop (forward-line -1))
- (looking-at ".*\\\\$")
- (not (nth 4 (parse-partial-sexp (match-beginning 0) (match-end 0)
- nil nil nil t))))))
-
-(defun sh-get-kw (&optional where and-move)
- "Return first word of line from WHERE.
-If AND-MOVE is non-nil then move to end of word."
- (let ((start (point)))
- (if where
- (goto-char where))
- (prog1
- (buffer-substring (point)
- (progn (skip-chars-forward "^ \t\n;&|")(point)))
- (unless and-move
- (goto-char start)))))
-
-(defun sh-find-prev-matching (open close &optional depth)
- "Find a matching token for a set of opening and closing keywords.
-This takes into account that there may be nested open..close pairings.
-OPEN and CLOSE are regexps denoting the tokens to be matched.
-Optional parameter DEPTH (usually 1) says how many to look for."
- (let ((parse-sexp-ignore-comments t)
- (forward-sexp-function nil)
- prev)
- (setq depth (or depth 1))
- (save-excursion
- (condition-case nil
- (while (and
- (/= 0 depth)
- (not (bobp))
- (setq prev (sh-prev-stmt)))
- (goto-char prev)
- (save-excursion
- (if (looking-at "\\\\\n")
- (progn
- (forward-char 2)
- (skip-chars-forward " \t")))
- (cond
- ((looking-at open)
- (setq depth (1- depth))
- (sh-debug "found open at %d - depth = %d" (point) depth))
- ((looking-at close)
- (setq depth (1+ depth))
- (sh-debug "found close - depth = %d" depth))
- (t
- ))))
- (error nil))
- (if (eq depth 0)
- prev ;; (point)
- nil)
- )))
-
(defun sh-var-value (var &optional ignore-error)
"Return the value of variable VAR, interpreting symbols.
@@ -3268,620 +2466,16 @@ IGNORE-ERROR is non-nil."
"Don't know how to handle %s's value of %s" var val)
0))))
-(defun sh-set-var-value (var value &optional no-symbol)
- "Set variable VAR to VALUE.
-Unless optional argument NO-SYMBOL is non-nil, then if VALUE is
-can be represented by a symbol then do so."
- (cond
- (no-symbol
- (set var value))
- ((= value sh-basic-offset)
- (set var '+))
- ((= value (- sh-basic-offset))
- (set var '-))
- ((eq value (* 2 sh-basic-offset))
- (set var '++))
- ((eq value (* 2 (- sh-basic-offset)))
- (set var '--))
- ((eq value (/ sh-basic-offset 2))
- (set var '*))
- ((eq value (/ (- sh-basic-offset) 2))
- (set var '/))
- (t
- (set var value)))
- )
-
-
-(defun sh-calculate-indent (&optional info)
- "Return the indentation for the current line.
-If INFO is supplied it is used, else it is calculated from current line."
- (let ((ofs 0)
- (base-value 0)
- elt a b val)
- (or info
- (setq info (sh-get-indent-info)))
- (when info
- (while info
- (sh-debug "info: %s ofs=%s" info ofs)
- (setq elt (car info))
- (cond
- ((stringp elt)) ;; do nothing?
- ((listp elt)
- (setq a (car (car info)))
- (setq b (nth 1 (car info)))
- (cond
- ((eq a t)
- (save-excursion
- (goto-char b)
- (setq val (current-indentation)))
- (setq base-value val))
- ((symbolp b)
- (setq val (sh-var-value b))
- (cond
- ((eq a '=)
- (cond
- ((null val)
- ;; no indentation
- ;; set info to nil so we stop immediately
- (setq base-value nil ofs nil info nil))
- ((eq val t) (setq ofs 0)) ;; indent as normal line
- (t
- ;; The following assume the (t POS) come first!
- (setq ofs val base-value 0)
- (setq info nil)))) ;; ? stop now
- ((eq a '+) (setq ofs (+ ofs val)))
- ((eq a '-) (setq ofs (- ofs val)))
- (t
- (error "sh-calculate-indent invalid a a=%s b=%s" a b))))
- (t
- (error "sh-calculate-indent invalid elt: a=%s b=%s" a b))))
- (t
- (error "sh-calculate-indent invalid elt %s" elt)))
- (sh-debug "a=%s b=%s val=%s base-value=%s ofs=%s"
- a b val base-value ofs)
- (setq info (cdr info)))
- ;; return value:
- (sh-debug "at end: base-value: %s ofs: %s" base-value ofs)
-
- (cond
- ((or (null base-value)(null ofs))
- nil)
- ((and (numberp base-value)(numberp ofs))
- (sh-debug "base (%d) + ofs (%d) = %d"
- base-value ofs (+ base-value ofs))
- (+ base-value ofs)) ;; return value
- (t
- (error "sh-calculate-indent: Help. base-value=%s ofs=%s"
- base-value ofs)
- nil)))))
+(define-obsolete-function-alias 'sh-show-indent
+ #'smie-config-show-indent "28.1")
+(define-obsolete-function-alias 'sh-set-indent #'smie-config-set-indent "28.1")
-(defun sh-indent-line ()
- "Indent the current line."
- (interactive)
- (let ((indent (sh-calculate-indent))
- (pos (- (point-max) (point))))
- (when indent
- (beginning-of-line)
- (skip-chars-forward " \t")
- (indent-line-to indent)
- ;; If initial point was within line's indentation,
- ;; position after the indentation. Else stay at same point in text.
- (if (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos))))))
-
-
-(defun sh-blink (blinkpos &optional msg)
- "Move cursor momentarily to BLINKPOS and display MSG."
- ;; We can get here without it being a number on first line
- (if (numberp blinkpos)
- (save-excursion
- (goto-char blinkpos)
- (if msg (message "%s" msg) (message nil))
- (sit-for blink-matching-delay))
- (if msg (message "%s" msg) (message nil))))
-
-(defun sh-show-indent (arg)
- "Show how the current line would be indented.
-This tells you which variable, if any, controls the indentation of
-this line.
-If optional arg ARG is non-null (called interactively with a prefix),
-a pop up window describes this variable.
-If variable `sh-blink' is non-nil then momentarily go to the line
-we are indenting relative to, if applicable."
- (interactive "P")
- (sh-must-support-indent)
- (if sh-use-smie
- (smie-config-show-indent)
- (let* ((info (sh-get-indent-info))
- (var (sh-get-indent-var-for-line info))
- (curr-indent (current-indentation))
- val msg)
- (if (stringp var)
- (message "%s" (setq msg var))
- (setq val (sh-calculate-indent info))
-
- (if (eq curr-indent val)
- (setq msg (format "%s is %s" var (symbol-value var)))
- (setq msg
- (if val
- (format "%s (%s) would change indent from %d to: %d"
- var (symbol-value var) curr-indent val)
- (format "%s (%s) would leave line as is"
- var (symbol-value var)))
- ))
- (if (and arg var)
- (describe-variable var)))
- (if sh-blink
- (let ((info (sh-get-indent-info)))
- (if (and info (listp (car info))
- (eq (car (car info)) t))
- (sh-blink (nth 1 (car info)) msg)
- (message "%s" msg)))
- (message "%s" msg))
- )))
+(define-obsolete-function-alias 'sh-learn-line-indent
+ #'smie-config-set-indent "28.1")
-(defun sh-set-indent ()
- "Set the indentation for the current line.
-If the current line is controlled by an indentation variable, prompt
-for a new value for it."
- (interactive)
- (sh-must-support-indent)
- (if sh-use-smie
- (smie-config-set-indent)
- (let* ((info (sh-get-indent-info))
- (var (sh-get-indent-var-for-line info))
- val old-val indent-val)
- (if (stringp var)
- (message "Cannot set indent - %s" var)
- (setq old-val (symbol-value var))
- (setq val (sh-read-variable var))
- (condition-case nil
- (progn
- (set var val)
- (setq indent-val (sh-calculate-indent info))
- (if indent-val
- (message "Variable: %s Value: %s would indent to: %d"
- var (symbol-value var) indent-val)
- (message "Variable: %s Value: %s would leave line as is."
- var (symbol-value var)))
- ;; I'm not sure about this, indenting it now?
- ;; No. Because it would give the impression that an undo would
- ;; restore thing, but the value has been altered.
- ;; (sh-indent-line)
- )
- (error
- (set var old-val)
- (message "Bad value for %s, restoring to previous value %s"
- var old-val)
- (sit-for 1)
- nil))
- ))))
-
-
-(defun sh-learn-line-indent (arg)
- "Learn how to indent a line as it currently is indented.
-
-If there is an indentation variable which controls this line's indentation,
-then set it to a value which would indent the line the way it
-presently is.
-
-If the value can be represented by one of the symbols then do so
-unless optional argument ARG (the prefix when interactive) is non-nil."
- (interactive "*P")
- (sh-must-support-indent)
- (if sh-use-smie
- (smie-config-set-indent)
- ;; I'm not sure if we show allow learning on an empty line.
- ;; Though it might occasionally be useful I think it usually
- ;; would just be confusing.
- (if (save-excursion
- (beginning-of-line)
- (looking-at "\\s-*$"))
- (message "sh-learn-line-indent ignores empty lines.")
- (let* ((info (sh-get-indent-info))
- (var (sh-get-indent-var-for-line info))
- ival sval diff new-val
- (no-symbol arg)
- (curr-indent (current-indentation)))
- (cond
- ((stringp var)
- (message "Cannot learn line - %s" var))
- ((eq var 'sh-indent-comment)
- ;; This is arbitrary...
- ;; - if curr-indent is 0, set to curr-indent
- ;; - else if it has the indentation of a "normal" line,
- ;; then set to t
- ;; - else set to curr-indent.
- (setq sh-indent-comment
- (if (= curr-indent 0)
- 0
- (let* ((sh-indent-comment t)
- (val2 (sh-calculate-indent info)))
- (if (= val2 curr-indent)
- t
- curr-indent))))
- (message "%s set to %s" var (symbol-value var))
- )
- ((numberp (setq sval (sh-var-value var)))
- (setq ival (sh-calculate-indent info))
- (setq diff (- curr-indent ival))
-
- (sh-debug "curr-indent: %d ival: %d diff: %d var:%s sval %s"
- curr-indent ival diff var sval)
- (setq new-val (+ sval diff))
- ;; I commented out this because someone might want to replace
- ;; a value of `+' with the current value of sh-basic-offset
- ;; or vice-versa.
- ;;(if (= 0 diff)
- ;; (message "No change needed!")
- (sh-set-var-value var new-val no-symbol)
- (message "%s set to %s" var (symbol-value var))
- )
- (t
- (debug)
- (message "Cannot change %s" var)))))))
-
-
-
-(defun sh-mark-init (buffer)
- "Initialize a BUFFER to be used by `sh-mark-line'."
- (with-current-buffer (get-buffer-create buffer)
- (erase-buffer)
- (occur-mode)))
-
-
-(defun sh-mark-line (message point buffer &optional add-linenum occur-point)
- "Insert MESSAGE referring to location POINT in current buffer into BUFFER.
-Buffer BUFFER is in `occur-mode'.
-If ADD-LINENUM is non-nil the message is preceded by the line number.
-If OCCUR-POINT is non-nil then the line is marked as a new occurrence
-so that `occur-next' and `occur-prev' will work."
- (let ((m1 (make-marker))
- start
- (line ""))
- (when point
- (set-marker m1 point (current-buffer))
- (if add-linenum
- (setq line (format "%d: " (1+ (count-lines 1 point))))))
- (save-excursion
- (if (get-buffer buffer)
- (set-buffer (get-buffer buffer))
- (set-buffer (get-buffer-create buffer))
- (occur-mode)
- )
- (goto-char (point-max))
- (setq start (point))
- (let ((inhibit-read-only t))
- (insert line)
- (if occur-point
- (setq occur-point (point)))
- (insert message)
- (if point
- (add-text-properties
- start (point)
- '(mouse-face highlight
- help-echo "mouse-2: go to the line where I learned this")))
- (insert "\n")
- (when point
- (put-text-property start (point) 'occur-target m1)
- (if occur-point
- (put-text-property start occur-point
- 'occur-match t))
- )))))
-
-;; Is this really worth having?
-(defvar sh-learned-buffer-hook nil
- "An abnormal hook, called with an alist of learned variables.")
-;; Example of how to use sh-learned-buffer-hook
-;;
-;; (defun what-i-learned (list)
-;; (let ((p list))
-;; (with-current-buffer "*scratch*"
-;; (goto-char (point-max))
-;; (insert "(setq\n")
-;; (while p
-;; (insert (format " %s %s \n"
-;; (nth 0 (car p)) (nth 1 (car p))))
-;; (setq p (cdr p)))
-;; (insert ")\n")
-;; )))
-;;
-;; (add-hook 'sh-learned-buffer-hook #'what-i-learned)
-
-
-;; Originally this was sh-learn-region-indent (beg end)
-;; However, in practice this was awkward so I changed it to
-;; use the whole buffer. Use narrowing if need be.
-(defun sh-learn-buffer-indent (&optional arg)
- "Learn how to indent the buffer the way it currently is.
-
-If `sh-use-smie' is non-nil, call `smie-config-guess'.
-Otherwise, run the sh-script specific indent learning command, as
-described below.
-
-Output in buffer \"*indent*\" shows any lines which have conflicting
-values of a variable, and the final value of all variables learned.
-When called interactively, pop to this buffer automatically if
-there are any discrepancies.
-
-If no prefix ARG is given, then variables are set to numbers.
-If a prefix arg is given, then variables are set to symbols when
-applicable -- e.g. to symbol `+' if the value is that of the
-basic indent.
-If a positive numerical prefix is given, then `sh-basic-offset'
-is set to the prefix's numerical value.
-Otherwise, sh-basic-offset may or may not be changed, according
-to the value of variable `sh-learn-basic-offset'.
-
-Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the
-function completes. The function is abnormal because it is called
-with an alist of variables learned.
-
-This command can often take a long time to run."
- (interactive "P")
- (sh-must-support-indent)
- (if sh-use-smie
- (smie-config-guess)
- (save-excursion
- (goto-char (point-min))
- (let ((learned-var-list nil)
- (out-buffer "*indent*")
- (num-diffs 0)
- previous-set-info
- (max 17)
- vec
- msg
- (comment-col nil) ;; number if all same, t if seen diff values
- (comments-always-default t) ;; nil if we see one not default
- initial-msg
- (specified-basic-offset (and arg (numberp arg)
- (> arg 0)))
- (linenum 0)
- suggested)
- (setq vec (make-vector max 0))
- (sh-mark-init out-buffer)
-
- (if specified-basic-offset
- (progn
- (setq sh-basic-offset arg)
- (setq initial-msg
- (format "Using specified sh-basic-offset of %d"
- sh-basic-offset)))
- (setq initial-msg
- (format "Initial value of sh-basic-offset: %s"
- sh-basic-offset)))
-
- (while (< (point) (point-max))
- (setq linenum (1+ linenum))
- ;; (if (zerop (% linenum 10))
- (message "line %d" linenum)
- ;; )
- (unless (looking-at "\\s-*$") ;; ignore empty lines!
- (let* ((sh-indent-comment t) ;; info must return default indent
- (info (sh-get-indent-info))
- (var (sh-get-indent-var-for-line info))
- sval ival diff new-val
- (curr-indent (current-indentation)))
- (cond
- ((null var)
- nil)
- ((stringp var)
- nil)
- ((numberp (setq sval (sh-var-value var 'no-error)))
- ;; the numberp excludes comments since sval will be t.
- (setq ival (sh-calculate-indent))
- (setq diff (- curr-indent ival))
- (setq new-val (+ sval diff))
- (sh-set-var-value var new-val 'no-symbol)
- (unless (looking-at "\\s-*#") ;; don't learn from comments
- (if (setq previous-set-info (assoc var learned-var-list))
- (progn
- ;; it was already there, is it same value ?
- (unless (eq (symbol-value var)
- (nth 1 previous-set-info))
- (sh-mark-line
- (format "Variable %s was set to %s"
- var (symbol-value var))
- (point) out-buffer t t)
- (sh-mark-line
- (format " but was previously set to %s"
- (nth 1 previous-set-info))
- (nth 2 previous-set-info) out-buffer t)
- (setq num-diffs (1+ num-diffs))
- ;; (delete previous-set-info learned-var-list)
- (setcdr previous-set-info
- (list (symbol-value var) (point)))
- )
- )
- (setq learned-var-list
- (append (list (list var (symbol-value var)
- (point)))
- learned-var-list)))
- (if (numberp new-val)
- (progn
- (sh-debug
- "This line's indent value: %d" new-val)
- (if (< new-val 0)
- (setq new-val (- new-val)))
- (if (< new-val max)
- (aset vec new-val (1+ (aref vec new-val))))))
- ))
- ((eq var 'sh-indent-comment)
- (unless (= curr-indent (sh-calculate-indent info))
- ;; this is not the default indentation
- (setq comments-always-default nil)
- (if comment-col ;; then we have see one before
- (or (eq comment-col curr-indent)
- (setq comment-col t)) ;; seen a different one
- (setq comment-col curr-indent))
- ))
- (t
- (sh-debug "Cannot learn this line!!!")
- ))
- (sh-debug
- "at %s learned-var-list is %s" (point) learned-var-list)
- ))
- (forward-line 1)
- ) ;; while
- (if sh-debug
- (progn
- (setq msg (format
- "comment-col = %s comments-always-default = %s"
- comment-col comments-always-default))
- ;; (message msg)
- (sh-mark-line msg nil out-buffer)))
- (cond
- ((eq comment-col 0)
- (setq msg "\nComments are all in 1st column.\n"))
- (comments-always-default
- (setq msg "\nComments follow default indentation.\n")
- (setq comment-col t))
- ((numberp comment-col)
- (setq msg (format "\nComments are in col %d." comment-col)))
- (t
- (setq msg "\nComments seem to be mixed, leaving them as is.\n")
- (setq comment-col nil)
- ))
- (sh-debug msg)
- (sh-mark-line msg nil out-buffer)
-
- (sh-mark-line initial-msg nil out-buffer t t)
-
- (setq suggested (sh-guess-basic-offset vec))
-
- (if (and suggested (not specified-basic-offset))
- (let ((new-value
- (cond
- ;; t => set it if we have a single value as a number
- ((and (eq sh-learn-basic-offset t) (numberp suggested))
- suggested)
- ;; other non-nil => set it if only one value was found
- (sh-learn-basic-offset
- (if (numberp suggested)
- suggested
- (if (= (length suggested) 1)
- (car suggested))))
- (t
- nil))))
- (if new-value
- (progn
- (setq learned-var-list
- (append (list (list 'sh-basic-offset
- (setq sh-basic-offset new-value)
- (point-max)))
- learned-var-list))
- ;; Not sure if we need to put this line in, since
- ;; it will appear in the "Learned variable settings".
- (sh-mark-line
- (format "Changed sh-basic-offset to: %d" sh-basic-offset)
- nil out-buffer))
- (sh-mark-line
- (if (listp suggested)
- (format "Possible value(s) for sh-basic-offset: %s"
- (mapconcat 'int-to-string suggested " "))
- (format "Suggested sh-basic-offset: %d" suggested))
- nil out-buffer))))
-
-
- (setq learned-var-list
- (append (list (list 'sh-indent-comment comment-col (point-max)))
- learned-var-list))
- (setq sh-indent-comment comment-col)
- (let ((name (buffer-name)))
- (sh-mark-line "\nLearned variable settings:" nil out-buffer)
- (if arg
- ;; Set learned variables to symbolic rather than numeric
- ;; values where possible.
- (dolist (learned-var (reverse learned-var-list))
- (let ((var (car learned-var))
- (val (nth 1 learned-var)))
- (when (and (not (eq var 'sh-basic-offset))
- (numberp val))
- (sh-set-var-value var val)))))
- (dolist (learned-var (reverse learned-var-list))
- (let ((var (car learned-var)))
- (sh-mark-line (format " %s %s" var (symbol-value var))
- (nth 2 learned-var) out-buffer)))
- (with-current-buffer out-buffer
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (insert
- (format "Indentation values for buffer %s.\n" name)
- (format "%d indentation variable%s different values%s\n\n"
- num-diffs
- (if (= num-diffs 1)
- " has" "s have")
- (if (zerop num-diffs)
- "." ":"))))))
- (run-hook-with-args 'sh-learned-buffer-hook learned-var-list)
- (and (called-interactively-p 'any)
- (or sh-popup-occur-buffer (> num-diffs 0))
- (pop-to-buffer out-buffer))))))
-
-(defun sh-guess-basic-offset (vec)
- "See if we can determine a reasonable value for `sh-basic-offset'.
-This is experimental, heuristic and arbitrary!
-Argument VEC is a vector of information collected by
-`sh-learn-buffer-indent'.
-Return values:
- number - there appears to be a good single value
- list of numbers - no obvious one, here is a list of one or more
- reasonable choices
- nil - we couldn't find a reasonable one."
- (let* ((max (1- (length vec)))
- (i 1)
- (totals (make-vector max 0)))
- (while (< i max)
- (cl-incf (aref totals i) (* 4 (aref vec i)))
- (if (zerop (% i 2))
- (cl-incf (aref totals i) (aref vec (/ i 2))))
- (if (< (* i 2) max)
- (cl-incf (aref totals i) (aref vec (* i 2))))
- (setq i (1+ i)))
-
- (let ((x nil)
- (result nil)
- tot sum p)
- (setq i 1)
- (while (< i max)
- (if (/= (aref totals i) 0)
- (push (cons i (aref totals i)) x))
- (setq i (1+ i)))
-
- (setq x (sort (nreverse x) (lambda (a b) (> (cdr a) (cdr b)))))
- (setq tot (apply '+ (append totals nil)))
- (sh-debug (format "vec: %s\ntotals: %s\ntot: %d"
- vec totals tot))
- (cond
- ((zerop (length x))
- (message "no values!")) ;; we return nil
- ((= (length x) 1)
- (message "only value is %d" (car (car x)))
- (setq result (car (car x)))) ;; return single value
- ((> (cdr (car x)) (/ tot 2))
- ;; 1st is > 50%
- (message "basic-offset is probably %d" (car (car x)))
- (setq result (car (car x)))) ;; again, return a single value
- ((>= (cdr (car x)) (* 2 (cdr (car (cdr x)))))
- ;; 1st is >= 2 * 2nd
- (message "basic-offset could be %d" (car (car x)))
- (setq result (car (car x))))
- ((>= (+ (cdr (car x))(cdr (car (cdr x)))) (/ tot 2))
- ;; 1st & 2nd together >= 50% - return a list
- (setq p x sum 0 result nil)
- (while (and p
- (<= (setq sum (+ sum (cdr (car p)))) (/ tot 2)))
- (setq result (append result (list (car (car p)))))
- (setq p (cdr p)))
- (message "Possible choices for sh-basic-offset: %s"
- (mapconcat 'int-to-string result " ")))
- (t
- (message "No obvious value for sh-basic-offset. Perhaps %d"
- (car (car x)))
- ;; result is nil here
- ))
- result)))
+(define-obsolete-function-alias 'sh-learn-buffer-indent
+ #'smie-config-guess "28.1")
;; ========================================================================
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 7d1f5ef6544..6b0df2d700d 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -232,9 +232,6 @@
(require 'cl-lib)
(require 'comint)
-;; Need the following to allow GNU Emacs 19 to compile the file.
-(eval-when-compile
- (require 'regexp-opt))
(require 'custom)
(require 'thingatpt)
(require 'view)
@@ -257,7 +254,6 @@
(defcustom sql-user ""
"Default username."
:type 'string
- :group 'SQL
:safe 'stringp)
(defcustom sql-password ""
@@ -265,33 +261,28 @@
If you customize this, the value will be stored in your init
file. Since that is a plaintext file, this could be dangerous."
:type 'string
- :group 'SQL
:risky t)
(defcustom sql-database ""
"Default database."
:type 'string
- :group 'SQL
:safe 'stringp)
(defcustom sql-server ""
"Default server or host."
:type 'string
- :group 'SQL
:safe 'stringp)
(defcustom sql-port 0
"Default port for connecting to a MySQL or Postgres server."
:version "24.1"
:type 'number
- :group 'SQL
:safe 'numberp)
(defcustom sql-default-directory nil
"Default directory for SQL processes."
:version "25.1"
:type '(choice (const nil) string)
- :group 'SQL
:safe 'stringp)
;; Login parameter type
@@ -348,8 +339,7 @@ file. Since that is a plaintext file, this could be dangerous."
(const :format "" :completion)
(sexp :tag ":completion")
(const :format "" :must-match)
- (restricted-sexp
- :match-alternatives (listp stringp))))
+ (symbol :tag ":must-match")))
(const port)))
;; SQL Product support
@@ -461,7 +451,7 @@ file. Since that is a plaintext file, this could be dangerous."
:prompt-regexp "^mysql> "
:prompt-length 6
:prompt-cont-regexp "^ -> "
- :syntax-alist ((?# . "< b"))
+ :syntax-alist ((?# . "< b") (?\\ . "\\"))
:input-filter sql-remove-tabs-filter)
(oracle
@@ -707,9 +697,9 @@ making new SQLi sessions."
(repeat :inline t
(list :tab "Other"
(symbol :tag " Variable Symbol")
+ ;; FIXME: Why "Value *Expression*"?
(sexp :tag "Value Expression")))))
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
(defvaralias 'sql-dialect 'sql-product)
@@ -723,7 +713,6 @@ This allows highlighting buffers properly when you open them."
(capitalize (symbol-name (car prod-info))))
,(car prod-info)))
sql-product-alist))
- :group 'SQL
:safe 'symbolp)
;; SQL indent support
@@ -735,7 +724,6 @@ SQL statements with easy customizations to support varied layout
requirements.
The package must be available to be loaded and activated."
- :group 'SQL
:link '(url-link "https://elpa.gnu.org/packages/sql-indent.html")
:type 'boolean
:version "27.1")
@@ -846,12 +834,11 @@ host key."
(setq w (locate-user-emacs-file (concat "sql-wallet" ext)
(concat ".sql-wallet" ext)))
(when (file-exists-p w)
- (setq wallet w)))))
+ (setq wallet (list w))))))
"Identification of the password wallet.
See `sql-password-search-wallet-function' to understand how this value
is used to locate the password wallet."
- :type `(plist-get (symbol-plist 'auth-sources) 'custom-type)
- :group 'SQL
+ :type (plist-get (symbol-plist 'auth-sources) 'custom-type)
:version "27.1")
(defvar sql-password-search-wallet-function #'sql-auth-source-search-wallet
@@ -878,8 +865,7 @@ current input in the SQLi buffer to the process."
:type '(choice (const :tag "Nothing" nil)
(const :tag "The semicolon `;'" semicolon)
(const :tag "The string `go' by itself" go))
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-send-terminator nil
"When non-nil, add a terminator to text sent to the SQL interpreter.
@@ -905,10 +891,9 @@ it automatically."
(const :tag "Default Terminator" t)
(string :tag "Terminator String")
(cons :tag "Terminator Pattern and String"
- (string :tag "Terminator Pattern")
+ (regexp :tag "Terminator Pattern")
(string :tag "Terminator String")))
- :version "22.2"
- :group 'SQL)
+ :version "22.2")
(defvar sql-contains-names nil
"When non-nil, the current buffer contains database names.
@@ -932,8 +917,7 @@ buffer."
:type '(choice (const :tag "Default" t)
(const :tag "No display" nil)
(function :tag "Display Buffer function"))
- :version "27.1"
- :group 'SQL)
+ :version "27.1")
;; imenu support for sql-mode.
@@ -971,8 +955,7 @@ This is used to initialize `comint-input-ring-file-name'.
Note that the size of the input history is determined by the variable
`comint-input-ring-size'."
:type '(choice (const :tag "none" nil)
- (file))
- :group 'SQL)
+ (file)))
(defcustom sql-input-ring-separator "\n--\n"
"Separator between commands in the history file.
@@ -987,21 +970,18 @@ does not have it, setting `sql-input-ring-separator' will have no
effect. In that case multiline commands will be split into several
commands when the input history is read, as if you had set
`sql-input-ring-separator' to \"\\n\"."
- :type 'string
- :group 'SQL)
+ :type 'string)
;; The usual hooks
(defcustom sql-interactive-mode-hook '(sql-indent-enable)
"Hook for customizing `sql-interactive-mode'."
:type 'hook
- :group 'SQL
:version "27.1")
(defcustom sql-mode-hook '(sql-indent-enable)
"Hook for customizing `sql-mode'."
:type 'hook
- :group 'SQL
:version "27.1")
(defcustom sql-set-sqli-hook '()
@@ -1009,8 +989,7 @@ commands when the input history is read, as if you had set
This is called by `sql-set-sqli-buffer' when the value of `sql-buffer'
is changed."
- :type 'hook
- :group 'SQL)
+ :type 'hook)
(defcustom sql-login-hook '()
"Hook for interacting with a buffer in `sql-interactive-mode'.
@@ -1018,8 +997,7 @@ is changed."
This hook is invoked in a buffer once it is ready to accept input
for the first time."
:version "24.1"
- :type 'hook
- :group 'SQL)
+ :type 'hook)
;; Customization for ANSI
@@ -1033,8 +1011,7 @@ All products share this list; products should define a regexp to
identify additional keywords in a variable defined by
the :statement feature."
:version "24.1"
- :type 'string
- :group 'SQL)
+ :type 'regexp)
;; Customization for Oracle
@@ -1046,27 +1023,23 @@ Starts `sql-interactive-mode' after doing some setup.
On Windows, \"sqlplus\" usually starts the sqlplus \"GUI\". In order
to start the sqlplus console, use \"plus33\" or something similar.
You will find the file in your Orant\\bin directory."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-oracle-options '("-L")
"List of additional options for `sql-oracle-program'."
:type '(repeat string)
- :version "24.4"
- :group 'SQL)
+ :version "24.4")
(defcustom sql-oracle-login-params '(user password database)
"List of login parameters needed to connect to Oracle."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
(defcustom sql-oracle-statement-starters
(regexp-opt '("declare" "begin" "with"))
"Additional statement starting keywords in Oracle."
:version "24.1"
- :type 'string
- :group 'SQL)
+ :type 'string)
(defcustom sql-oracle-scan-on t
"Non-nil if placeholders should be replaced in Oracle SQLi.
@@ -1082,8 +1055,7 @@ You need to issue the following command in SQL*Plus to be safe:
In older versions of SQL*Plus, this was the SET SCAN OFF command."
:version "24.1"
- :type 'boolean
- :group 'SQL)
+ :type 'boolean)
(defcustom sql-db2-escape-newlines nil
"Non-nil if newlines should be escaped by a backslash in DB2 SQLi.
@@ -1092,8 +1064,7 @@ When non-nil, Emacs will automatically insert a space and
backslash prior to every newline in multi-line SQL statements as
they are submitted to an interactive DB2 session."
:version "24.3"
- :type 'boolean
- :group 'SQL)
+ :type 'boolean)
;; Customization for SQLite
@@ -1103,21 +1074,18 @@ they are submitted to an interactive DB2 session."
"Command to start SQLite.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-sqlite-options nil
"List of additional options for `sql-sqlite-program'."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-sqlite-login-params '((database :file nil
:must-match confirm))
"List of login parameters needed to connect to SQLite."
:type 'sql-login-params
- :version "26.1"
- :group 'SQL)
+ :version "26.1")
;; Customization for MariaDB
@@ -1134,22 +1102,19 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start mysql by Oracle.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-mysql-options nil
"List of additional options for `sql-mysql-program'.
The following list of options is reported to make things work
on Windows: \"-C\" \"-t\" \"-f\" \"-n\"."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-mysql-login-params '(user password database server)
"List of login parameters needed to connect to MySQL."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Solid
@@ -1157,14 +1122,12 @@ on Windows: \"-C\" \"-t\" \"-f\" \"-n\"."
"Command to start SOLID SQL Editor.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-solid-login-params '(user password server)
"List of login parameters needed to connect to Solid."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Sybase
@@ -1172,21 +1135,18 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start isql by Sybase.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-sybase-options nil
"List of additional options for `sql-sybase-program'.
Some versions of isql might require the -n option in order to work."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-sybase-login-params '(server user password database)
"List of login parameters needed to connect to Sybase."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Informix
@@ -1194,14 +1154,12 @@ Some versions of isql might require the -n option in order to work."
"Command to start dbaccess by Informix.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-informix-login-params '(database)
"List of login parameters needed to connect to Informix."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Ingres
@@ -1209,14 +1167,12 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start sql by Ingres.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-ingres-login-params '(database)
"List of login parameters needed to connect to Ingres."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Microsoft
@@ -1229,21 +1185,18 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start osql by Microsoft.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-ms-options '("-w" "300" "-n")
;; -w is the linesize
"List of additional options for `sql-ms-program'."
:type '(repeat string)
- :version "22.1"
- :group 'SQL)
+ :version "22.1")
(defcustom sql-ms-login-params '(user password server database)
"List of login parameters needed to connect to Microsoft."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Postgres
@@ -1251,8 +1204,7 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start psql by Postgres.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-postgres-options '("-P" "pager=off")
"List of additional options for `sql-postgres-program'.
@@ -1263,8 +1215,7 @@ name, add the string \"-u\" to the list of options. If you want to
provide a user name on the command line (newer versions such as 7.1),
add your name with a \"-U\" prefix (such as \"-Umark\") to the list."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-postgres-login-params
`((user :default ,(user-login-name))
@@ -1275,8 +1226,7 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list."
server)
"List of login parameters needed to connect to Postgres."
:type 'sql-login-params
- :version "26.1"
- :group 'SQL)
+ :version "26.1")
(defun sql-postgres-list-databases ()
"Return a list of available PostgreSQL databases."
@@ -1297,20 +1247,17 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list."
"Command to start isql by Interbase.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-interbase-options nil
"List of additional options for `sql-interbase-program'."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-interbase-login-params '(user password database)
"List of login parameters needed to connect to Interbase."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for DB2
@@ -1318,20 +1265,17 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start db2 by IBM.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-db2-options nil
"List of additional options for `sql-db2-program'."
:type '(repeat string)
- :version "20.8"
- :group 'SQL)
+ :version "20.8")
(defcustom sql-db2-login-params nil
"List of login parameters needed to connect to DB2."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
;; Customization for Linter
@@ -1339,20 +1283,17 @@ Starts `sql-interactive-mode' after doing some setup."
"Command to start inl by RELEX.
Starts `sql-interactive-mode' after doing some setup."
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-linter-options nil
"List of additional options for `sql-linter-program'."
:type '(repeat string)
- :version "21.3"
- :group 'SQL)
+ :version "21.3")
(defcustom sql-linter-login-params '(user password database server)
"Login parameters to needed to connect to Linter."
:type 'sql-login-params
- :version "24.1"
- :group 'SQL)
+ :version "24.1")
@@ -1436,10 +1377,7 @@ specified, it's `sql-product' or `sql-connection' must match."
(defvar sql-interactive-mode-map
(let ((map (make-sparse-keymap)))
- (if (fboundp 'set-keymap-parent)
- (set-keymap-parent map comint-mode-map); Emacs
- (if (fboundp 'set-keymap-parents)
- (set-keymap-parents map (list comint-mode-map)))); XEmacs
+ (set-keymap-parent map comint-mode-map)
(if (fboundp 'set-keymap-name)
(set-keymap-name map 'sql-interactive-mode-map)); XEmacs
(define-key map (kbd "C-j") 'sql-accumulate-and-indent)
@@ -2374,7 +2312,8 @@ function `regexp-opt'.")
"ansi_warnings" "forceplan" "showplan_all" "showplan_text"
"statistics" "implicit_transactions" "remote_proc_transactions"
"transaction" "xact_abort"
-) t)
+)
+ t)
"\\)\\)\\|go\\s-*\\|use\\s-+\\|setuser\\s-+\\|dbcc\\s-+\\).*$")
'font-lock-doc-face)
@@ -2856,7 +2795,7 @@ See `sql-product-alist' for a list of products and supported features."
(member feature sql-indirect-features)
(not not-indirect)
(symbolp v))
- (eval v)
+ (symbol-value v)
v))
(error "`%s' is not a known product; use `sql-add-product' to add it first." product)
nil)))
@@ -4244,8 +4183,7 @@ must tell Emacs. Here's how to do that in your init file:
\(add-hook \\='sql-mode-hook
(lambda ()
- (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))"
- :group 'SQL
+ (modify-syntax-entry ?\\\\ \"\\\\\" sql-mode-syntax-table)))"
:abbrev-table sql-mode-abbrev-table
(if sql-mode-menu
@@ -4268,6 +4206,18 @@ must tell Emacs. Here's how to do that in your init file:
(setq-local abbrev-all-caps 1)
;; Contains the name of database objects
(set (make-local-variable 'sql-contains-names) t)
+ (setq-local syntax-propertize-function
+ (syntax-propertize-rules
+ ;; Handle escaped apostrophes within strings.
+ ("''"
+ (0
+ (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax ".")
+ (forward-char -1)
+ nil)))
+ ;; Propertize rules to not have /- and -* start comments.
+ ("\\(/-\\)" (1 "."))
+ ("\\(-\\*\\)" (1 "."))))
;; Set syntax and font-face highlighting
;; Catch changes to sql-product and highlight accordingly
(sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591
@@ -4280,7 +4230,7 @@ must tell Emacs. Here's how to do that in your init file:
(put 'sql-interactive-mode 'mode-class 'special)
(put 'sql-interactive-mode 'custom-mode-group 'SQL)
;; FIXME: Why not use `define-derived-mode'?
-(defun sql-interactive-mode ()
+(define-derived-mode sql-interactive-mode comint-mode "SQLi[?]"
"Major mode to use a SQL interpreter interactively.
Do not call this function by yourself. The environment must be
@@ -4340,17 +4290,18 @@ Here is an example for your init file. It keeps the SQLi buffer a
certain length.
\(add-hook \\='sql-interactive-mode-hook
- (function (lambda ()
- (setq comint-output-filter-functions #\\='comint-truncate-buffer))))
+ (lambda ()
+ (setq comint-output-filter-functions #\\='comint-truncate-buffer)))
Here is another example. It will always put point back to the statement
you entered, right above the output it created.
\(setq comint-output-filter-functions
- (function (lambda (STR) (comint-show-output))))"
+ (lambda (STR) (comint-show-output)))"
+ :syntax-table sql-mode-syntax-table
;; FIXME: The doc above uses `setq' on `comint-output-filter-functions',
;; whereas hooks should be manipulated with things like `add/remove-hook'.
- (delay-mode-hooks (comint-mode))
+ :after-hook (sql--adjust-interactive-setup)
;; Get the `sql-product' for this interactive session.
(set (make-local-variable 'sql-product)
@@ -4358,14 +4309,11 @@ you entered, right above the output it created.
sql-product))
;; Setup the mode.
- (setq major-mode 'sql-interactive-mode)
(setq mode-name
(concat "SQLi[" (or (sql-get-product-feature sql-product :name)
(symbol-name sql-product)) "]"))
- (use-local-map sql-interactive-mode-map)
(if sql-interactive-mode-menu
(easy-menu-add sql-interactive-mode-menu)) ; XEmacs
- (set-syntax-table sql-mode-syntax-table)
;; Note that making KEYWORDS-ONLY nil will cause havoc if you try
;; SELECT 'x' FROM DUAL with SQL*Plus, because the title of the column
@@ -4409,9 +4357,10 @@ you entered, right above the output it created.
(add-hook 'comint-preoutput-filter-functions
#'sql-interactive-remove-continuation-prompt nil t)
(make-local-variable 'sql-input-ring-separator)
- (make-local-variable 'sql-input-ring-file-name)
- ;; Run the mode hook (along with comint's hooks).
- (run-mode-hooks 'sql-interactive-mode-hook)
+ (make-local-variable 'sql-input-ring-file-name))
+
+(defun sql--adjust-interactive-setup ()
+ "Finish the mode's setup after running the mode hook."
;; Set comint based on user overrides.
(setq comint-prompt-regexp
(if sql-prompt-cont-regexp
@@ -4490,7 +4439,7 @@ is specified in the connection settings."
(dolist (vv connect-set)
(let ((var (car vv))
(val (cadr vv)))
- (set-default var (eval val))))
+ (set-default var (eval val)))) ;FIXME: Why `eval'?
(setq-default sql-connection connection)
;; :sqli-login params variable
@@ -4521,10 +4470,10 @@ is specified in the connection settings."
(if vals (cons var vals) var)))))
;; Start the SQLi session with revised list of login parameters
- (eval `(let ((,param-var ',rem-vars))
- (sql-product-interactive
- ',sql-product
- ',(or buf-name (format "<%s>" connection))))))
+ (cl-progv (list param-var) (list rem-vars)
+ (sql-product-interactive
+ sql-product
+ (or buf-name (format "<%s>" connection)))))
(user-error "SQL Connection <%s> does not exist" connection)
nil)))
@@ -4595,7 +4544,10 @@ optionally is saved to the user's init file."
(format "Connection <%s>\t%s" (car conn)
(let ((sql-user "") (sql-database "")
(sql-server "") (sql-port 0))
- (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name)))))
+ (cl-progv
+ (mapcar #'car (cdr conn))
+ (mapcar #'cadr (cdr conn))
+ (sql-make-alternate-buffer-name))))
(list 'sql-connect (car conn))
t))
sql-connection-alist)
@@ -4977,8 +4929,7 @@ The default comes from `process-coding-system-alist' and
See the distinct values in ALL_OBJECTS.OBJECT_TYPE for possible values."
:version "24.1"
- :type '(repeat string)
- :group 'SQL)
+ :type '(repeat string))
(defun sql-oracle-completion-object (sqlbuf schema)
(sql-redirect-value
@@ -5624,21 +5575,18 @@ buffer.
(defcustom sql-vertica-program "vsql"
"Command to start the Vertica client."
:version "25.1"
- :type 'file
- :group 'SQL)
+ :type 'file)
(defcustom sql-vertica-options '("-P" "pager=off")
"List of additional options for `sql-vertica-program'.
The default value disables the internal pager."
:version "25.1"
- :type '(repeat string)
- :group 'SQL)
+ :type '(repeat string))
(defcustom sql-vertica-login-params '(user password database server)
"List of login parameters needed to connect to Vertica."
:version "25.1"
- :type 'sql-login-params
- :group 'SQL)
+ :type 'sql-login-params)
(defun sql-comint-vertica (product options &optional buf-name)
"Create comint buffer and connect to Vertica."
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index f9b069fd4e5..0f2c9431f6e 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -115,6 +115,8 @@ treat nomenclature boundaries as word boundaries."
(when subword-mode (superword-mode -1))
(subword-setup-buffer))
+;; This is defined also in cc-cmds.el, but as obsolete since 24.3.
+;; Let's keep this until the other one can also be removed.
(define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2")
;;;###autoload
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 7ffa6d41dac..f0dd9afa4c0 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -1,4 +1,4 @@
-;;; tcl.el --- Tcl code editing commands for Emacs
+;;; tcl.el --- Tcl code editing commands for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1994, 1998-2020 Free Software Foundation, Inc.
@@ -120,20 +120,17 @@
(defcustom tcl-indent-level 4
"Indentation of Tcl statements with respect to containing block."
- :type 'integer
- :group 'tcl)
-(put 'tcl-indent-level 'safe-local-variable 'integerp)
+ :type 'integer)
+(put 'tcl-indent-level 'safe-local-variable #'integerp)
(defcustom tcl-continued-indent-level 4
"Indentation of continuation line relative to first line of command."
- :type 'integer
- :group 'tcl)
-(put 'tcl-continued-indent-level 'safe-local-variable 'integerp)
+ :type 'integer)
+(put 'tcl-continued-indent-level 'safe-local-variable #'integerp)
(defcustom tcl-auto-newline nil
"Non-nil means automatically newline before and after braces you insert."
- :type 'boolean
- :group 'tcl)
+ :type 'boolean)
(defcustom tcl-tab-always-indent tab-always-indent
"Control effect of TAB key.
@@ -151,8 +148,7 @@ to take place:
6. Move backward to start of comment, indenting if necessary."
:type '(choice (const :tag "Always" t)
(const :tag "Beginning only" nil)
- (other :tag "Maybe move or make or delete comment" tcl))
- :group 'tcl)
+ (other :tag "Maybe move or make or delete comment" tcl)))
(defcustom tcl-electric-hash-style nil ;; 'smart
@@ -163,28 +159,23 @@ meaning that the choice between `backslash' and `quote' should be
made depending on the number of hashes inserted; or nil, meaning that
no quoting should be done. Any other value for this variable is
taken to mean `smart'. The default is nil."
- :type '(choice (const backslash) (const quote) (const smart) (const nil))
- :group 'tcl)
+ :type '(choice (const backslash) (const quote) (const smart) (const nil)))
(defcustom tcl-help-directory-list nil
"List of topmost directories containing TclX help files."
- :type '(repeat directory)
- :group 'tcl)
+ :type '(repeat directory))
(defcustom tcl-use-smart-word-finder t
"If not nil, use smart way to find current word, for Tcl help feature."
- :type 'boolean
- :group 'tcl)
+ :type 'boolean)
(defcustom tcl-application "wish"
"Name of Tcl program to run in inferior Tcl mode."
- :type 'string
- :group 'tcl)
+ :type 'string)
(defcustom tcl-command-switches nil
"List of switches to supply to the `tcl-application' program."
- :type '(repeat string)
- :group 'tcl)
+ :type '(repeat string))
(defcustom tcl-prompt-regexp "^\\(% \\|\\)"
"If not nil, a regexp that will match the prompt in the inferior process.
@@ -192,8 +183,7 @@ If nil, the prompt is the name of the application with \">\" appended.
The default is \"^\\(% \\|\\)\", which will match the default primary
and secondary prompts for tclsh and wish."
- :type 'regexp
- :group 'tcl)
+ :type 'regexp)
(defcustom inferior-tcl-source-command "source %s\n"
"Format-string for building a Tcl command to load a file.
@@ -201,12 +191,10 @@ This format string should use `%s' to substitute a file name
and should result in a Tcl expression that will command the
inferior Tcl to load that file. The filename will be appropriately
quoted for Tcl."
- :type 'string
- :group 'tcl)
+ :type 'string)
(defface tcl-escaped-newline '((t :inherit font-lock-string-face))
"Face used for (non-escaped) backslash at end of a line in Tcl mode."
- :group 'tcl
:version "22.1")
;;
@@ -266,16 +254,16 @@ quoted for Tcl."
;; Maybe someone has a better set?
(let ((map (make-sparse-keymap)))
;; Will inherit from `comint-mode-map' thanks to define-derived-mode.
- (define-key map "\t" 'completion-at-point)
- (define-key map "\M-?" 'comint-dynamic-list-filename-completions)
- (define-key map "\177" 'backward-delete-char-untabify)
- (define-key map "\M-\C-x" 'tcl-eval-defun)
- (define-key map "\C-c\C-i" 'tcl-help-on-word)
- (define-key map "\C-c\C-v" 'tcl-eval-defun)
- (define-key map "\C-c\C-f" 'tcl-load-file)
- (define-key map "\C-c\C-t" 'inferior-tcl)
- (define-key map "\C-c\C-x" 'tcl-eval-region)
- (define-key map "\C-c\C-s" 'switch-to-tcl)
+ (define-key map "\t" #'completion-at-point)
+ (define-key map "\M-?" #'comint-dynamic-list-filename-completions)
+ (define-key map "\177" #'backward-delete-char-untabify)
+ (define-key map "\M-\C-x" #'tcl-eval-defun)
+ (define-key map "\C-c\C-i" #'tcl-help-on-word)
+ (define-key map "\C-c\C-v" #'tcl-eval-defun)
+ (define-key map "\C-c\C-f" #'tcl-load-file)
+ (define-key map "\C-c\C-t" #'inferior-tcl)
+ (define-key map "\C-c\C-x" #'tcl-eval-region)
+ (define-key map "\C-c\C-s" #'switch-to-tcl)
map)
"Keymap used in `inferior-tcl-mode'.")
@@ -356,7 +344,7 @@ information):
Add functions to the hook with `add-hook':
- (add-hook 'tcl-mode-hook 'tcl-guess-application)")
+ (add-hook 'tcl-mode-hook #'tcl-guess-application)")
(defvar tcl-proc-list
@@ -407,10 +395,65 @@ This variable is generally set from `tcl-proc-regexp',
`tcl-typeword-list', and `tcl-keyword-list' by the function
`tcl-set-font-lock-keywords'.")
+(eval-and-compile
+ (defconst tcl--word-delimiters "[;{ \t\n"))
+
+(defun tcl--syntax-of-quote (pos)
+ "Decide whether a double quote opens a string or not."
+ ;; This is pretty tricky, because strings can be written as "..."
+ ;; or as {...} or without any quoting at all for some simple and not so
+ ;; simple cases (e.g. `abc' but also `a"b'). To make things more
+ ;; interesting, code is represented as strings, so the content of
+ ;; strings can be later re-lexed to find nested strings.
+ (save-excursion
+ (let ((ppss (syntax-ppss pos)))
+ (cond
+ ((nth 8 ppss) nil) ;; Within a string or a comment.
+ ((not (memq (char-before pos)
+ (cons nil
+ (eval-when-compile
+ (mapcar #'identity tcl--word-delimiters)))))
+ ;; The double quote appears within some other lexical entity.
+ ;; FIXME: Similar treatment should be used for `{' which can appear
+ ;; within non-delimited strings (but only at top-level, so
+ ;; maybe it's not worth worrying about).
+ (string-to-syntax "."))
+ ((zerop (nth 0 ppss))
+ ;; Not within a { ... }, so can't be truncated by a }.
+ ;; FIXME: The syntax-table also considers () and [] as paren
+ ;; delimiters just like {}, even though Tcl treats them differently.
+ ;; Tho I'm not sure it's worth worrying about, either.
+ nil)
+ (t
+ ;; A double quote within a {...}: leave it as a normal string
+ ;; delimiter only if we don't find a closing } before we
+ ;; find a closing ".
+ (let ((type nil)
+ (depth 0))
+ (forward-char 1)
+ (while (and (not type)
+ (re-search-forward "[\"{}\\]" nil t))
+ (pcase (char-after (match-beginning 0))
+ (?\\ (forward-char 1))
+ (?\" (setq type 'matched))
+ (?\{ (cl-incf depth))
+ (?\} (if (zerop depth) (setq type 'unmatched)
+ (cl-incf depth)))))
+ (when (> (line-beginning-position) pos)
+ ;; The quote is not on the same line as the deciding
+ ;; factor, so make sure we revisit this choice later.
+ (put-text-property pos (point) 'syntax-multiline t))
+ (when (eq type 'unmatched)
+ ;; The quote has no matching close because a } closes the
+ ;; surrounding string before, so it doesn't really "open a string".
+ (string-to-syntax "."))))))))
+
(defconst tcl-syntax-propertize-function
+ ;; FIXME: Handle the [...] commands nested inside "..." strings.
(syntax-propertize-rules
;; Mark the few `#' that are not comment-markers.
- ("[^;[{ \t\n][ \t]*\\(#\\)" (1 ".")))
+ ((concat "[^" tcl--word-delimiters "][ \t]*\\(#\\)") (1 "."))
+ ("\"" (0 (tcl--syntax-of-quote (match-beginning 0)))))
"Syntactic keywords for `tcl-mode'.")
;; FIXME need some way to recognize variables because array refs look
@@ -575,8 +618,8 @@ already exist."
(unless (and (boundp 'filladapt-mode) filladapt-mode)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t))
- (set (make-local-variable 'indent-line-function) 'tcl-indent-line)
- (set (make-local-variable 'comment-indent-function) 'tcl-comment-indent)
+ (set (make-local-variable 'indent-line-function) #'tcl-indent-line)
+ (set (make-local-variable 'comment-indent-function) #'tcl-comment-indent)
;; Tcl doesn't require a final newline.
;; (make-local-variable 'require-final-newline)
;; (setq require-final-newline t)
@@ -593,6 +636,8 @@ already exist."
'(tcl-font-lock-keywords nil nil nil beginning-of-defun))
(set (make-local-variable 'syntax-propertize-function)
tcl-syntax-propertize-function)
+ (add-hook 'syntax-propertize-extend-region-functions
+ #'syntax-propertize-multiline 'append 'local)
(set (make-local-variable 'imenu-generic-expression)
tcl-imenu-generic-expression)
@@ -606,7 +651,7 @@ already exist."
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'defun-prompt-regexp) tcl-omit-ws-regexp)
(set (make-local-variable 'add-log-current-defun-function)
- 'tcl-add-log-defun)
+ #'tcl-add-log-defun)
(setq-local beginning-of-defun-function #'tcl-beginning-of-defun-function)
(setq-local end-of-defun-function #'tcl-end-of-defun-function)
@@ -1190,7 +1235,7 @@ See documentation for function `inferior-tcl-mode' for more information."
(setq inferior-tcl-buffer "*inferior-tcl*")
(pop-to-buffer "*inferior-tcl*"))
-(defalias 'run-tcl 'inferior-tcl)
+(defalias 'run-tcl #'inferior-tcl)
@@ -1346,9 +1391,8 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'."
(not tcl-use-smart-word-finder)
tcl-use-smart-word-finder))))
(completing-read
- (if (or (null word) (string= word ""))
- "Help on Tcl command: "
- (format "Help on Tcl command (default %s): " word))
+ (format-prompt "Help on Tcl command: "
+ (and (not (equal word "")) word))
tcl-help-alist nil t nil nil word)))
current-prefix-arg))
(if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
@@ -1556,21 +1600,21 @@ The first line is assumed to look like \"#!.../program ...\"."
(char-to-string char)))
string ""))
+
+
;;
-;; Bug reporting.
+;; Obsolete.
;;
-
-;; These are relics kept "just in case".
-(defalias 'tcl-uncomment-region 'uncomment-region)
-(defalias 'tcl-indent-for-comment 'comment-indent)
-(defalias 'add-log-tcl-defun 'tcl-add-log-defun)
-(defalias 'indent-tcl-exp 'tcl-indent-exp)
-(defalias 'calculate-tcl-indent 'tcl-calculate-indent)
-(defalias 'tcl-beginning-of-defun 'beginning-of-defun)
-(defalias 'tcl-end-of-defun 'end-of-defun)
-(defalias 'tcl-mark-defun 'mark-defun)
-(defun tcl-mark () (mark t))
+(define-obsolete-function-alias 'tcl-uncomment-region #'uncomment-region "28.1")
+(define-obsolete-function-alias 'tcl-indent-for-comment #'comment-indent "28.1")
+(define-obsolete-function-alias 'add-log-tcl-defun #'tcl-add-log-defun "28.1")
+(define-obsolete-function-alias 'indent-tcl-exp #'tcl-indent-exp "28.1")
+(define-obsolete-function-alias 'calculate-tcl-indent #'tcl-calculate-indent "28.1")
+(define-obsolete-function-alias 'tcl-beginning-of-defun #'beginning-of-defun "28.1")
+(define-obsolete-function-alias 'tcl-end-of-defun #'end-of-defun "28.1")
+(define-obsolete-function-alias 'tcl-mark-defun #'mark-defun "28.1")
+(defun tcl-mark () (declare (obsolete nil "28.1")) (mark t))
(provide 'tcl)
diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el
index 3c9ced02916..8bde89e774e 100644
--- a/lisp/progmodes/vera-mode.el
+++ b/lisp/progmodes/vera-mode.el
@@ -1,4 +1,4 @@
-;;; vera-mode.el --- major mode for editing Vera files
+;;; vera-mode.el --- major mode for editing Vera files -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2020 Free Software Foundation, Inc.
@@ -33,9 +33,7 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Commentary:
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This package provides a simple Emacs major mode for editing Vera code.
;; It includes the following features:
@@ -44,38 +42,11 @@
;; - Indentation
;; - Word/keyword completion
;; - Block commenting
-;; - Works under GNU Emacs and XEmacs
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Documentation
;; See comment string of function `vera-mode' or type `C-h m' in Emacs.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Installation
-
-;; Prerequisites: GNU Emacs 20.X/21.X, XEmacs 20.X/21.X
-
-;; Put `vera-mode.el' into the `site-lisp' directory of your Emacs installation
-;; or into an arbitrary directory that is added to the load path by the
-;; following line in your Emacs start-up file (`.emacs'):
-
-;; (setq load-path (cons (expand-file-name "<directory-name>") load-path))
-
-;; If you already have the compiled `vera-mode.elc' file, put it in the same
-;; directory. Otherwise, byte-compile the source file:
-;; Emacs: M-x byte-compile-file -> vera-mode.el
-;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vera-mode.el
-
-;; Add the following lines to the `site-start.el' file in the `site-lisp'
-;; directory of your Emacs installation or to your Emacs start-up file
-;; (`.emacs'):
-
-;; (autoload 'vera-mode "vera-mode" "Vera Mode" t)
-;; (setq auto-mode-alist (cons '("\\.vr[hi]?\\'" . vera-mode) auto-mode-alist))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -90,16 +61,14 @@
(defcustom vera-basic-offset 2
"Amount of basic offset used for indentation."
- :type 'integer
- :group 'vera)
+ :type 'integer)
(defcustom vera-underscore-is-part-of-word nil
"Non-nil means consider the underscore character `_' as part of word.
An identifier containing underscores is then treated as a single word in
select and move operations. All parts of an identifier separated by underscore
are treated as single words otherwise."
- :type 'boolean
- :group 'vera)
+ :type 'boolean)
(make-obsolete-variable 'vera-underscore-is-part-of-word
'superword-mode "24.4")
@@ -110,8 +79,7 @@ else if not at beginning of line then insert tab,
else if last command was a `TAB' or `RET' then dedent one step,
else indent current line.
If nil, TAB always indents current line."
- :type 'boolean
- :group 'vera)
+ :type 'boolean)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -125,9 +93,6 @@ If nil, TAB always indents current line."
(let ((map (make-sparse-keymap)))
;; Backspace/delete key bindings.
(define-key map [backspace] 'backward-delete-char-untabify)
- (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable
- (define-key map [delete] 'delete-char)
- (define-key map [(meta delete)] 'kill-word))
;; Standard key bindings.
(define-key map "\M-e" 'vera-forward-statement)
(define-key map "\M-a" 'vera-backward-statement)
@@ -227,9 +192,7 @@ If nil, TAB always indents current line."
(modify-syntax-entry ?\{ "(}" syntax-table)
(modify-syntax-entry ?\} "){" syntax-table)
;; comment
- (if (featurep 'xemacs)
- (modify-syntax-entry ?\/ ". 1456" syntax-table) ; XEmacs
- (modify-syntax-entry ?\/ ". 124b" syntax-table)) ; Emacs
+ (modify-syntax-entry ?\/ ". 124b" syntax-table)
(modify-syntax-entry ?\* ". 23" syntax-table)
;; newline and CR
(modify-syntax-entry ?\n "> b" syntax-table)
@@ -314,8 +277,6 @@ Key bindings:
;; initialize font locking
(set (make-local-variable 'font-lock-defaults)
'(vera-font-lock-keywords nil nil ((?\_ . "w"))))
- ;; add menu (XEmacs)
- (easy-menu-add vera-mode-menu)
;; miscellaneous
(message "Vera Mode %s. Type C-c C-h for documentation." vera-version))
@@ -542,12 +503,6 @@ Key bindings:
)
"List of Vera-RVM predefined constants.")
-;; `regexp-opt' undefined (`xemacs-devel' not installed)
-(unless (fboundp 'regexp-opt)
- (defun regexp-opt (strings &optional paren)
- (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
- (concat open (mapconcat 'regexp-quote strings "\\|") close))))
-
(defconst vera-keywords-regexp
(concat "\\<\\(" (regexp-opt vera-keywords) "\\)\\>")
"Regexp for Vera keywords.")
@@ -796,10 +751,7 @@ This function does not modify point or mark."
(defun vera-skip-forward-literal ()
"Skip forward literal and return t if within one."
- (let ((state (save-excursion
- (if (fboundp 'syntax-ppss)
- (syntax-ppss)
- (parse-partial-sexp (point-min) (point))))))
+ (let ((state (save-excursion (syntax-ppss))))
(when (nth 8 state)
;; Inside a string or comment.
(goto-char (nth 8 state))
@@ -814,10 +766,7 @@ This function does not modify point or mark."
(defun vera-skip-backward-literal ()
"Skip backward literal and return t if within one."
- (let ((state (save-excursion
- (if (fboundp 'syntax-ppss)
- (syntax-ppss)
- (parse-partial-sexp (point-min) (point))))))
+ (let ((state (save-excursion (syntax-ppss))))
(when (nth 8 state)
;; Inside a string or comment.
(goto-char (nth 8 state))
@@ -1232,6 +1181,8 @@ Calls `indent-region' for whole buffer."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; electrifications
+(defvar hippie-expand-only-buffers)
+
(defun vera-electric-tab (&optional prefix)
"Do what I mean (indent, expand, tab, change indent, etc..).
If preceding character is part of a word or a paren then `hippie-expand',
@@ -1243,7 +1194,7 @@ If `vera-intelligent-tab' is nil, always indent line."
(interactive "*P")
(if vera-intelligent-tab
(progn
- (cond ((and (not (featurep 'xemacs)) (use-region-p))
+ (cond ((use-region-p)
(vera-indent-region (region-beginning) (region-end) nil))
((memq (char-syntax (preceding-char)) '(?w ?_))
(let ((case-fold-search t)
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 460957b7161..b1abefe534e 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -9,7 +9,7 @@
;; Keywords: languages
;; The "Version" is the date followed by the decimal rendition of the Git
;; commit hex.
-;; Version: 2019.12.17.268053413
+;; Version: 2020.06.27.014326051
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
;; file on 19/3/2008, and the maintainer agreed that when a bug is
@@ -124,7 +124,7 @@
;;
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "2019-12-17-ffa2ba5-vpo-GNU"
+(defconst verilog-mode-version "2020-06-27-0da9923-vpo-GNU"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -605,7 +605,7 @@ are lineup only when \\[verilog-pretty-declarations] is typed."
(function :tag "Other"))
:group 'verilog-mode-indent )
(put 'verilog-auto-lineup 'safe-local-variable
- '(lambda (x) (memq x '(nil all assignments declarations))))
+ (lambda (x) (memq x '(nil all assignments declarations))))
(defcustom verilog-indent-level 3
"Indentation of Verilog statements with respect to containing block."
@@ -958,8 +958,8 @@ See `compilation-error-regexp-alist-alist' for the formatting. For XEmacs.")
("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 1 bold t)
("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 2 bold t)
;; verilog-verilator
- (".*%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t)
- (".*%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t)
+ (".*\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t)
+ (".*\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t)
;; verilog-leda
("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 1 bold t)
("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 2 bold t)
@@ -1118,7 +1118,7 @@ SystemVerilog designs."
:type 'boolean
:group 'verilog-mode-auto)
(put 'verilog-auto-reset-widths 'safe-local-variable
- '(lambda (x) (memq x '(nil t unbased))))
+ (lambda (x) (memq x '(nil t unbased))))
(defcustom verilog-assignment-delay ""
"Text used for delays in delayed assignments. Add a trailing space if set."
@@ -1138,7 +1138,7 @@ line."
(const :tag "Line up Assignment statements" single))
:group 'verilog-mode-auto)
(put 'verilog-auto-arg-format 'safe-local-variable
- '(lambda (x) (memq x '(packed single))))
+ (lambda (x) (memq x '(packed single))))
(defcustom verilog-auto-arg-sort nil
"Non-nil means AUTOARG signal names will be sorted, not in declaration order.
@@ -1263,7 +1263,7 @@ otherwise no vectors if sizes match (like using nil)."
:group 'verilog-mode-auto
:type '(choice (const nil) (const t) (const unsigned)))
(put 'verilog-auto-inst-vector 'safe-local-variable
- '(lambda (x) (memq x '(nil t unsigned))))
+ (lambda (x) (memq x '(nil t unsigned))))
(defcustom verilog-auto-inst-template-numbers nil
"If true, when creating templated ports with AUTOINST, add a comment.
@@ -1280,7 +1280,19 @@ won't merge conflict."
:group 'verilog-mode-auto
:type '(choice (const nil) (const t) (const lhs)))
(put 'verilog-auto-inst-template-numbers 'safe-local-variable
- '(lambda (x) (memq x '(nil t lhs))))
+ (lambda (x) (memq x '(nil t lhs))))
+
+(defcustom verilog-auto-inst-template-required nil
+ "If non-nil, when creating a port with AUTOINST, require a template.
+Any port which does not have a template will be omitted from the
+instantiation.
+
+If nil, if a port is not templated it will be inserted to connect
+to a net with the same name as the port."
+ :version "28.0"
+ :group 'verilog-mode-auto
+ :type 'boolean)
+(put 'verilog-auto-inst-template-required 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-inst-column 40
"Indent-to column number for net name part of AUTOINST created pin."
@@ -1418,7 +1430,7 @@ See also `verilog-case-fold'."
:type 'hook)
(defvar verilog-imenu-generic-expression
- '((nil "^\\s-*\\(?:m\\(?:odule\\|acromodule\\)\\|p\\(?:rimitive\\|rogram\\|ackage\\)\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 1)
+ '((nil "^\\s-*\\(?:connectmodule\\|m\\(?:odule\\|acromodule\\)\\|p\\(?:rimitive\\|rogram\\|ackage\\)\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 1)
("*Variables*" "^\\s-*\\(reg\\|wire\\|logic\\)\\s-+\\(\\|\\[[^]]+\\]\\s-+\\)\\([A-Za-z0-9_]+\\)" 3)
("*Classes*" "^\\s-*\\(?:\\(?:virtual\\|interface\\)\\s-+\\)?class\\s-+\\([A-Za-z_][A-Za-z0-9_]+\\)" 1)
("*Tasks*" "^\\s-*\\(?:\\(?:static\\|pure\\|virtual\\|local\\|protected\\)\\s-+\\)*task\\s-+\\(?:\\(?:static\\|automatic\\)\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_:]+\\)" 1)
@@ -2503,11 +2515,13 @@ find the errors."
(eval-when-compile
(verilog-regexp-words
'( "begin"
+ "connectmodule"
"else"
"end"
"endcase"
"endclass"
"endclocking"
+ "endconnectmodule"
"endgroup"
"endfunction"
"endmodule"
@@ -2550,6 +2564,7 @@ find the errors."
"\\(sequence\\)\\|" ; 14
"\\(clocking\\)\\|" ; 15
"\\(property\\)\\|" ; 16
+ "\\(connectmodule\\)\\|" ; 17
"\\)\\>\\)"))
(defconst verilog-end-block-re
(eval-when-compile
@@ -2710,6 +2725,7 @@ find the errors."
"endclass"
"endclocking"
"endconfig"
+ "endconnectmodule"
"endfunction"
"endgenerate"
"endgroup"
@@ -2728,7 +2744,7 @@ find the errors."
(defconst verilog-declaration-opener
(eval-when-compile
(verilog-regexp-words
- '("module" "begin" "task" "function"))))
+ '("connectmodule" "module" "begin" "task" "function"))))
(defconst verilog-declaration-prefix-re
(eval-when-compile
@@ -2790,9 +2806,9 @@ find the errors."
(defconst verilog-declaration-re-1-no-macro (concat "^" verilog-declaration-re-2-no-macro))
(defconst verilog-defun-re
- (eval-when-compile (verilog-regexp-words '("macromodule" "module" "class" "program" "interface" "package" "primitive" "config"))))
+ (eval-when-compile (verilog-regexp-words '("macromodule" "connectmodule" "module" "class" "program" "interface" "package" "primitive" "config"))))
(defconst verilog-end-defun-re
- (eval-when-compile (verilog-regexp-words '("endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig"))))
+ (eval-when-compile (verilog-regexp-words '("endconnectmodule" "endmodule" "endclass" "endprogram" "endinterface" "endpackage" "endprimitive" "endconfig"))))
(defconst verilog-zero-indent-re
(concat verilog-defun-re "\\|" verilog-end-defun-re))
(defconst verilog-inst-comment-re
@@ -2824,7 +2840,7 @@ find the errors."
"generate" "endgenerate"
"initial"
"interface" "endinterface"
- "module" "macromodule" "endmodule"
+ "connectmodule" "module" "macromodule" "endconnectmodule" "endmodule"
"package" "endpackage"
"primitive" "endprimitive"
"program" "endprogram"
@@ -2892,14 +2908,14 @@ find the errors."
(defconst verilog-defun-level-not-generate-re
(eval-when-compile
(verilog-regexp-words
- '( "module" "macromodule" "primitive" "class" "program"
+ '( "connectmodule" "module" "macromodule" "primitive" "class" "program"
"interface" "package" "config"))))
(defconst verilog-defun-level-re
(eval-when-compile
(verilog-regexp-words
(append
- '( "module" "macromodule" "primitive" "class" "program"
+ '( "connectmodule" "module" "macromodule" "primitive" "class" "program"
"interface" "package" "config")
'( "initial" "final" "always" "always_comb" "always_ff"
"always_latch" "endtask" "endfunction" )))))
@@ -2914,7 +2930,7 @@ find the errors."
(eval-when-compile
(verilog-regexp-words
'(
- "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass"
+ "endconnectmodule" "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass"
))))
(defconst verilog-dpi-import-export-re
@@ -2935,7 +2951,7 @@ find the errors."
(eval-when-compile
(verilog-regexp-words
'(
- "always" "assign" "always_latch" "always_ff" "always_comb" "constraint"
+ "always" "assign" "always_latch" "always_ff" "always_comb" "connectmodule" "constraint"
"import" "initial" "final" "module" "macromodule" "repeat" "randcase" "while"
"if" "for" "forever" "foreach" "else" "parameter" "do" "localparam" "assert"
))))
@@ -3053,6 +3069,8 @@ find the errors."
"sync_reject_on" "unique0" "until" "until_with" "untyped" "weak"
;; 1800-2012
"implements" "interconnect" "nettype" "soft"
+ ;; AMS
+ "connectmodule" "endconnectmodule"
))
"List of Verilog keywords.")
@@ -3117,7 +3135,7 @@ See also `verilog-font-lock-extra-types'.")
(:foreground "DimGray" :italic t))
(((class grayscale) (background dark))
(:foreground "LightGray" :italic t))
- (t (:italis t)))
+ (t (:italic t)))
"Font lock mode face used to background highlight translate-off regions."
:group 'font-lock-highlighting-faces)
@@ -3199,7 +3217,7 @@ See also `verilog-font-lock-extra-types'.")
"atan2" "atanh" "branch" "ceil" "connect" "connectmodule"
"connectrules" "continuous" "cos" "cosh" "ddt" "ddt_nature"
"ddx" "discipline" "discrete" "domain" "driver_update"
- "endconnectrules" "enddiscipline" "endnature" "endparamset"
+ "endconnectmodule" "endconnectrules" "enddiscipline" "endnature" "endparamset"
"exclude" "exp" "final_step" "flicker_noise" "floor" "flow"
"from" "ground" "hypot" "idt" "idt_nature" "idtmod" "inf"
"initial_step" "laplace_nd" "laplace_np" "laplace_zd"
@@ -3278,9 +3296,9 @@ See also `verilog-font-lock-extra-types'.")
(list
;; Fontify module definitions
(list
- "\\<\\(\\(macro\\)?module\\|primitive\\|class\\|program\\|interface\\|package\\|task\\)\\>\\s-*\\(\\sw+\\)"
+ "\\<\\(\\(macro\\|connect\\)?module\\|primitive\\|class\\|program\\|interface\\|package\\|task\\)\\>\\s-*\\(\\sw+\\)"
'(1 font-lock-keyword-face)
- '(3 font-lock-function-name-face 'prepend))
+ '(3 font-lock-function-name-face prepend))
;; Fontify function definitions
(list
(concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" )
@@ -3290,7 +3308,16 @@ See also `verilog-font-lock-extra-types'.")
(1 font-lock-keyword-face)
(2 font-lock-constant-face append))
'("\\<function\\>\\s-+\\(\\sw+\\)"
- 1 'font-lock-constant-face append))))
+ 1 'font-lock-constant-face append)
+ ;; Fontify variable names in declarations
+ (list ;; Implemented as an anchored-matcher
+ (concat verilog-declaration-re
+ " *\\(" verilog-range-re "\\)?")
+ (list ;; anchored-highlighter
+ (concat "\\_<\\(" verilog-symbol-re "\\)"
+ " *\\(" verilog-range-re "\\)?*")
+ nil nil '(1 font-lock-variable-name-face))))))
+
(setq verilog-font-lock-keywords-2
(append verilog-font-lock-keywords-1
@@ -3596,7 +3623,7 @@ Use filename, if current buffer being edited shorten to just buffer name."
(setq found 't))))))
((looking-at verilog-end-block-re)
(verilog-leap-to-head))
- ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)")
+ ((looking-at "\\(endmodule\\>\\)\\|\\(\\<endprimitive\\>\\)\\|\\(\\<endclass\\>\\)\\|\\(\\<endprogram\\>\\)\\|\\(\\<endinterface\\>\\)\\|\\(\\<endpackage\\>\\)\\|\\(\\<endconnectmodule\\>\\)")
(cond
((match-end 1)
(verilog-re-search-backward "\\<\\(macro\\)?module\\>" nil 'move))
@@ -3610,6 +3637,8 @@ Use filename, if current buffer being edited shorten to just buffer name."
(verilog-re-search-backward "\\<interface\\>" nil 'move))
((match-end 6)
(verilog-re-search-backward "\\<package\\>" nil 'move))
+ ((match-end 7)
+ (verilog-re-search-backward "\\<connectmodule\\>" nil 'move))
(t
(goto-char st)
(backward-sexp 1))))
@@ -3735,7 +3764,8 @@ Use filename, if current buffer being edited shorten to just buffer name."
"\\(\\<class\\>\\)\\|"
"\\(\\<program\\>\\)\\|"
"\\(\\<interface\\>\\)\\|"
- "\\(\\<package\\>\\)"))
+ "\\(\\<package\\>\\)\\|"
+ "\\(\\<connectmodule\\>\\)"))
(cond
((match-end 1)
(verilog-re-search-forward "\\<endmodule\\>" nil 'move))
@@ -3749,6 +3779,8 @@ Use filename, if current buffer being edited shorten to just buffer name."
(verilog-re-search-forward "\\<endinterface\\>" nil 'move))
((match-end 6)
(verilog-re-search-forward "\\<endpackage\\>" nil 'move))
+ ((match-end 7)
+ (verilog-re-search-forward "\\<endconnectmodule\\>" nil 'move))
(t
(goto-char st)
(if (= (following-char) ?\) )
@@ -4556,13 +4588,13 @@ More specifically, point @ in the line foo : @ begin"
(let ((nest 1))
(while t
(verilog-re-search-backward
- (concat "\\(\\<module\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|"
+ (concat "\\(\\<module\\>\\)\\|\\(\\<connectmodule\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|"
"\\(\\<endcase\\>\\)\\>")
nil 'move)
(cond
- ((match-end 3)
+ ((match-end 4)
(setq nest (1+ nest)))
- ((match-end 2)
+ ((match-end 3)
(if (= nest 1)
(throw 'found 1))
(setq nest (1- nest)))
@@ -4571,9 +4603,11 @@ More specifically, point @ in the line foo : @ begin"
nil)))
(defun verilog-backward-up-list (arg)
- "Call `backward-up-list' ARG, ignoring comments."
+ "Call `backward-up-list' ARG, ignoring comments and errors."
(let ((parse-sexp-ignore-comments t))
- (backward-up-list arg)))
+ (condition-case nil
+ (backward-up-list arg) ;; May throw Unbalanced parenthesis
+ (error nil))))
(defun verilog-forward-sexp-cmt (arg)
"Call `forward-sexp' ARG, inside comments."
@@ -4595,13 +4629,15 @@ More specifically, after a generate and before an endgenerate."
(while (and
(/= nest 0)
(verilog-re-search-backward
- "\\<\\(module\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\>" nil 'move)
+ "\\<\\(module\\)\\|\\(connectmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\>" nil 'move)
(cond
((match-end 1) ; module - we have crawled out
(throw 'done 1))
- ((match-end 2) ; generate
+ ((match-end 2) ; connectmodule - we have crawled out
+ (throw 'done 1))
+ ((match-end 3) ; generate
(setq nest (1- nest)))
- ((match-end 3) ; endgenerate
+ ((match-end 4) ; endgenerate
(setq nest (1+ nest))))))))
(= nest 0) )) ; return nest
@@ -5064,6 +5100,8 @@ primitive or interface named NAME."
(setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>"))
((match-end 16) ; of verilog-end-block-ordered-re
(setq reg "\\(\\<property\\>\\)\\|\\<endproperty\\>"))
+ ((match-end 17) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<connectmodule\\>\\)\\|\\<endconnectmodule\\>"))
(t (error "Problem in verilog-set-auto-endcomments")))
(let (b e)
@@ -5089,7 +5127,7 @@ primitive or interface named NAME."
(setq string (buffer-substring b e)))
(t
(ding 't)
- (setq string "unmatched end(function|task|module|primitive|interface|package|class|clocking)")))))
+ (setq string "unmatched end(function|task|module|connectmodule|primitive|interface|package|class|clocking)")))))
(end-of-line)
(insert (concat " // " string )))
))))))))))
@@ -5345,7 +5383,7 @@ becomes:
(interactive)
(save-excursion
(beginning-of-line)
- (when (looking-at "\\(.*\\)([WE]\\([0-9A-Z]+\\)).*,\\s +line\\s +[0-9]+:\\s +\\([^:\n]+\\):?.*$")
+ (when (looking-at "\\(.*\\)([WE]\\([0-9A-Z]+\\)).*,\\s +line\\s +[0-9]+:\\s +\\([^:\n]+\\).*$")
(replace-match (format
;; %3s makes numbers 1-999 line up nicely
"\\1//Verilint %3s off // WARNING: \\3"
@@ -5560,7 +5598,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(case-fold-search nil)
(par 0)
(begin (looking-at "[ \t]*begin\\>"))
- (lim (save-excursion (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<module\\>\\)" nil t)))
+ (lim (save-excursion (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<\\(connect\\)?module\\>\\)" nil t)))
(structres nil)
(type (catch 'nesting
;; Keep working backwards until we can figure out
@@ -6788,7 +6826,7 @@ Do not count named blocks or case-statements."
((looking-at verilog-named-block-re)
(current-column))
((and (not (looking-at verilog-extended-case-re))
- (looking-at "^[^:;]+[ \t]*:"))
+ (looking-at "^[^:;]+:"))
(verilog-re-search-forward ":" nil t)
(skip-chars-forward " \t")
(current-column))
@@ -7113,7 +7151,7 @@ BASEIND is the base indent to offset everything."
(let ((pos (point-marker))
(lim (save-excursion
;; (verilog-re-search-backward verilog-declaration-opener nil 'move)
- (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<module\\>\\)\\|\\(\\<task\\>\\)" nil 'move)
+ (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<\\(connect\\)?module\\>\\)\\|\\(\\<task\\>\\)" nil 'move)
(point)))
(ind)
(val)
@@ -7272,7 +7310,7 @@ it displays a list of all possible completions.")
\(integer, real, reg...)")
(defvar verilog-cpp-keywords
- '("module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else"
+ '("connectmodule" "module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else"
"endif")
"Keywords to complete when at first word of a line in declarative scope.
\(initial, always, begin, assign...)
@@ -7283,7 +7321,7 @@ will be completed at runtime and should not be added to this list.")
(append
'(
"always" "always_comb" "always_ff" "always_latch" "assign"
- "begin" "end" "generate" "endgenerate" "module" "endmodule"
+ "begin" "end" "connectmodule" "endconnectmodule" "generate" "endgenerate" "module" "endmodule"
"specify" "endspecify" "function" "endfunction" "initial" "final"
"task" "endtask" "primitive" "endprimitive"
)
@@ -7380,9 +7418,9 @@ TYPE is `module', `tf' for task or function, or t if unknown."
(if (string= verilog-str "")
(setq verilog-str "[a-zA-Z_]"))
(let ((verilog-str (concat (cond
- ((eq type 'module) "\\<\\(module\\)\\s +")
+ ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +")
((eq type 'tf) "\\<\\(task\\|function\\)\\s +")
- (t "\\<\\(task\\|function\\|module\\)\\s +"))
+ (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +"))
"\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>"))
match)
@@ -7724,7 +7762,7 @@ If search fails, other files are checked based on
(first 1)
(prevpos (point-min))
(final-context-start (make-marker))
- (regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)"))
+ (regexp "\\(\\(connect\\)?module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)"))
(with-output-to-temp-buffer "*Occur*"
(save-excursion
(message "Searching for %s ..." regexp)
@@ -7782,7 +7820,7 @@ If search fails, other files are checked based on
"Return point if within translate-off region, else nil."
(and (save-excursion
(re-search-backward
- (concat "//\\s-*.*\\s-*" verilog-directive-regexp "\\(on\\|off\\)\\>")
+ (concat "//.*" verilog-directive-regexp "\\(on\\|off\\)\\>")
nil t))
(equal "off" (match-string 2))
(point)))
@@ -7790,14 +7828,14 @@ If search fails, other files are checked based on
(defun verilog-start-translate-off (limit)
"Return point before translate-off directive if before LIMIT, else nil."
(when (re-search-forward
- (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>")
+ (concat "//.*" verilog-directive-regexp "off\\>")
limit t)
(match-beginning 0)))
(defun verilog-back-to-start-translate-off (limit)
"Return point before translate-off directive if before LIMIT, else nil."
(when (re-search-backward
- (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>")
+ (concat "//.*" verilog-directive-regexp "off\\>")
limit t)
(match-beginning 0)))
@@ -7805,7 +7843,7 @@ If search fails, other files are checked based on
"Return point after translate-on directive if before LIMIT, else nil."
(re-search-forward (concat
- "//\\s-*.*\\s-*" verilog-directive-regexp "on\\>") limit t))
+ "//.*" verilog-directive-regexp "on\\>") limit t))
(defun verilog-match-translate-off (limit)
"Match a translate-off block, setting `match-data' and returning t, else nil.
@@ -8445,7 +8483,8 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters."
(let ((olist))
(save-excursion
;; /*AUTOPUNT("parameter", "parameter")*/
- (backward-sexp 1)
+ (when (not (eq (char-before) ?\*)) ; Not .*
+ (backward-sexp 1))
(while (looking-at "(?\\s *\"\\([^\"]*\\)\"\\s *,?")
(setq olist (cons (match-string-no-properties 1) olist))
(goto-char (match-end 0))))
@@ -9895,7 +9934,7 @@ Allows version control to check out the file if need be."
(while (and
;; It may be tempting to look for verilog-defun-re,
;; don't, it slows things down a lot!
- (verilog-re-search-forward-quick "\\<\\(module\\|interface\\|program\\)\\>" nil t)
+ (verilog-re-search-forward-quick "\\<\\(connectmodule\\|module\\|interface\\|program\\)\\>" nil t)
(setq type (match-string-no-properties 0))
(verilog-re-search-forward-quick "[(;]" nil t))
(if (equal module (verilog-read-module-name))
@@ -9982,7 +10021,7 @@ Or, just the existing dirnames themselves if there are no wildcards."
(while dirnames
(setq dirname (car dirnames)
dirnames (cdr dirnames))
- (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ; root
+ (cond ((string-match (concat "^\\(\\|[^*?]*[/\\]\\)" ; root
"\\([^/\\]*[*?][^/\\]*\\)" ; filename with *?
"\\(.*\\)") ; rest
dirname)
@@ -10923,9 +10962,9 @@ shown) will make this into:
;; Presume one module per file.
(save-excursion
(goto-char (point-min))
- (while (verilog-re-search-forward-quick "\\<module\\>" nil t)
+ (while (verilog-re-search-forward-quick "\\<\\(connect\\)?module\\>" nil t)
(let ((endmodp (save-excursion
- (verilog-re-search-forward-quick "\\<endmodule\\>" nil t)
+ (verilog-re-search-forward-quick "\\<end\\(connect\\)?module\\>" nil t)
(point))))
;; See if there's already a comment .. inside a comment so not verilog-re-search
(when (not (re-search-forward "/\\*AUTOARG\\*/" endmodp t))
@@ -11370,9 +11409,10 @@ See the example in `verilog-auto-inout-modport'."
(defvar vl-bits nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defvar vl-mbits nil "See `verilog-auto-inst'.") ; Prevent compile warning
-(defun verilog-auto-inst-port (port-st indent-pt moddecls tpl-list tpl-num for-star par-values)
+(defun verilog-auto-inst-port (section port-st indent-pt moddecls tpl-list tpl-num
+ for-star par-values)
"Print out an instantiation connection for this PORT-ST.
-Insert to INDENT-PT, use template TPL-LIST.
+Inside SECTION, insert to INDENT-PT, use template TPL-LIST.
@ are instantiation numbers, replaced with TPL-NUM.
@\"(expression @)\" are evaluated, with @ as a variable.
If FOR-STAR add comment it is a .* expansion.
@@ -11474,60 +11514,74 @@ If PAR-VALUES replace final strings with these parameter values."
(setq tpl-net (verilog-string-replace-matches "\\[\\]\\[\\]" dflt-bits nil nil tpl-net))
(setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net)))
;; Insert it
- (indent-to indent-pt)
- (insert "." port)
- (unless (and verilog-auto-inst-dot-name
- (equal port tpl-net))
- (indent-to verilog-auto-inst-column)
- (insert "(" tpl-net ")"))
- (insert ",")
- (cond (tpl-ass
- (verilog-read-auto-template-hit tpl-ass)
- (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
- verilog-auto-inst-column))
- ;; verilog-insert requires the complete comment in one call - including the newline
- (cond ((equal verilog-auto-inst-template-numbers 'lhs)
- (verilog-insert " // Templated"
- " LHS: " (nth 0 tpl-ass)
- "\n"))
- (verilog-auto-inst-template-numbers
- (verilog-insert " // Templated"
- " T" (int-to-string (nth 2 tpl-ass))
- " L" (int-to-string (nth 3 tpl-ass))
- "\n"))
- (t
- (verilog-insert " // Templated\n"))))
- (for-star
- (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
- verilog-auto-inst-column))
- (verilog-insert " // Implicit .*\n"))
- (t
- (insert "\n")))))
-;;(verilog-auto-inst-port (list "foo" "[5:0]") 10 (list (list "foo" "a@\"(% (+ @ 1) 4)\"a")) "3")
+ (when (or tpl-ass (not verilog-auto-inst-template-required))
+ (verilog-auto-inst-first section)
+ (indent-to indent-pt)
+ (insert "." port)
+ (unless (and verilog-auto-inst-dot-name
+ (equal port tpl-net))
+ (indent-to verilog-auto-inst-column)
+ (insert "(" tpl-net ")"))
+ (insert ",")
+ (cond (tpl-ass
+ (verilog-read-auto-template-hit tpl-ass)
+ (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
+ verilog-auto-inst-column))
+ ;; verilog-insert requires the complete comment in one call - including the newline
+ (cond ((equal verilog-auto-inst-template-numbers 'lhs)
+ (verilog-insert " // Templated"
+ " LHS: " (nth 0 tpl-ass)
+ "\n"))
+ (verilog-auto-inst-template-numbers
+ (verilog-insert " // Templated"
+ " T" (int-to-string (nth 2 tpl-ass))
+ " L" (int-to-string (nth 3 tpl-ass))
+ "\n"))
+ (t
+ (verilog-insert " // Templated\n"))))
+ (for-star
+ (indent-to (+ (if (< verilog-auto-inst-column 48) 24 16)
+ verilog-auto-inst-column))
+ (verilog-insert " // Implicit .*\n"))
+ (t
+ (insert "\n"))))))
+;;(verilog-auto-inst-port "" (list "foo" "[5:0]") 10 (list (list "foo" "a@\"(% (+ @ 1) 4)\"a")) "3")
;;(x "incom[@\"(+ (* 8 @) 7)\":@\"(* 8 @)\"]")
;;(x ".out (outgo[@\"(concat (+ (* 8 @) 7) \\\":\\\" ( * 8 @))\"]));")
-(defun verilog-auto-inst-port-list (sig-list indent-pt moddecls tpl-list tpl-num for-star par-values)
- "For `verilog-auto-inst' print a list of ports using `verilog-auto-inst-port'."
- (when verilog-auto-inst-sort
- (setq sig-list (sort (copy-alist sig-list) #'verilog-signals-sort-compare)))
- (mapc (lambda (port)
- (verilog-auto-inst-port port indent-pt moddecls
- tpl-list tpl-num for-star par-values))
- sig-list))
+(defvar verilog-auto-inst-first-section nil
+ "Local first-in-section for `verilog-auto-inst-first'.")
+(defvar verilog-auto-inst-first-any nil
+ "Local first-in-any-section for `verilog-auto-inst-first'.")
-(defun verilog-auto-inst-first ()
- "Insert , etc before first ever port in this instant, as part of \\[verilog-auto-inst]."
+(defun verilog-auto-inst-first (section)
+ "Insert , and SECTION before port, as part of \\[verilog-auto-inst]."
;; Do we need a trailing comma?
;; There maybe an ifdef or something similar before us. What a mess. Thus
;; to avoid trouble we only insert on preceding ) or *.
;; Insert first port on new line
- (insert "\n") ; Must insert before search, so point will move forward if insert comma
- (save-excursion
- (verilog-re-search-backward-quick "[^ \t\n\f]" nil nil)
- (when (looking-at ")\\|\\*") ; Generally don't insert, unless we are fairly sure
- (forward-char 1)
- (insert ","))))
+ (when verilog-auto-inst-first-any
+ (setq verilog-auto-inst-first-any nil)
+ (insert "\n") ; Must insert before search, so point will move forward if insert comma
+ (save-excursion
+ (verilog-re-search-backward-quick "[^ \t\n\f]" nil nil)
+ (when (looking-at ")\\|\\*") ; Generally don't insert, unless we are fairly sure
+ (forward-char 1)
+ (insert ","))))
+ (when verilog-auto-inst-first-section
+ (setq verilog-auto-inst-first-section nil)
+ (verilog-insert-indent section)))
+
+(defun verilog-auto-inst-port-list (section sig-list indent-pt moddecls
+ tpl-list tpl-num for-star par-values)
+ "For `verilog-auto-inst' print a list of ports using `verilog-auto-inst-port'."
+ (when verilog-auto-inst-sort
+ (setq sig-list (sort (copy-alist sig-list) #'verilog-signals-sort-compare)))
+ (let ((verilog-auto-inst-first-section t))
+ (mapc (lambda (port)
+ (verilog-auto-inst-port section port indent-pt moddecls
+ tpl-list tpl-num for-star par-values))
+ sig-list)))
(defun verilog-auto-star ()
"Expand SystemVerilog .* pins, as part of \\[verilog-auto].
@@ -11554,6 +11608,9 @@ Replace the pin connections to an instantiation or interface
declaration with ones automatically derived from the module or
interface header of the instantiated item.
+You may also provide an optional regular expression, in which
+case only I/O matching the regular expression will be included.
+
If `verilog-auto-star-expand' is set, also expand SystemVerilog .* ports,
and delete them before saving unless `verilog-auto-star-save' is set.
See `verilog-auto-star' for more information.
@@ -11697,6 +11754,10 @@ Templates:
debugging is completed though, it will result in lots of extra differences
and merge conflicts.
+ If a connection name does not match any template, it is
+ connected to a net by the same name as the port (unless
+ `verilog-auto-inst-template-required' is true).
+
Setting `verilog-auto-template-warn-unused' will report errors
if any template lines are unused.
@@ -11868,16 +11929,19 @@ For more information see the \\[verilog-faq] and forums at URL
`https://www.veripool.org'."
(save-excursion
;; Find beginning
- (let* ((pt (point))
+ (let* ((params (verilog-read-auto-params 0 1))
+ (regexp (nth 0 params))
+ (pt (point))
(for-star (save-excursion (backward-char 2) (looking-at "\\.\\*")))
(indent-pt (save-excursion (verilog-backward-open-paren)
(1+ (current-column))))
(verilog-auto-inst-column (max verilog-auto-inst-column
(+ 16 (* 8 (/ (+ indent-pt 7) 8)))))
+ (verilog-auto-inst-first-any t)
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
submod submodi submoddecls
- inst skip-pins tpl-list tpl-num did-first par-values)
+ inst skip-pins tpl-list tpl-num par-values)
;; Find module name that is instantiated
(setq submod (verilog-read-inst-module)
@@ -11912,53 +11976,58 @@ For more information see the \\[verilog-faq] and forums at URL
(verilog-decls-get-vars submoddecls)
skip-pins)))
(vl-dir "interfaced"))
+ (when regexp
+ (setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when (and sig-list
verilog-auto-inst-interfaced-ports)
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
;; Note these are searched for in verilog-read-sub-decls.
- (verilog-insert-indent "// Interfaced\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
+ (verilog-auto-inst-port-list "// Interfaced\n"
+ sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-interfaces submoddecls)
skip-pins))
(vl-dir "interface"))
+ (when regexp
+ (setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when sig-list
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
;; Note these are searched for in verilog-read-sub-decls.
- (verilog-insert-indent "// Interfaces\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
- tpl-list tpl-num for-star par-values)))
+ (verilog-auto-inst-port-list "// Interfaces\n"
+ sig-list indent-pt moddecls
+ tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-outputs submoddecls)
skip-pins))
(vl-dir "output"))
+ (when regexp
+ (setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when sig-list
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
- (verilog-insert-indent "// Outputs\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
+ (verilog-auto-inst-port-list "// Outputs\n"
+ sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-inouts submoddecls)
skip-pins))
(vl-dir "inout"))
+ (when regexp
+ (setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when sig-list
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
- (verilog-insert-indent "// Inouts\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
+ (verilog-auto-inst-port-list "// Inouts\n"
+ sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-inputs submoddecls)
skip-pins))
(vl-dir "input"))
+ (when regexp
+ (setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when sig-list
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
- (verilog-insert-indent "// Inputs\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
+ (verilog-auto-inst-port-list "// Inputs\n"
+ sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
;; Kill extra semi
(save-excursion
- (cond (did-first
+ (cond ((not verilog-auto-inst-first-any)
(re-search-backward "," pt t)
(delete-char 1)
(insert ");")
@@ -12020,10 +12089,11 @@ Templates:
(1+ (current-column))))
(verilog-auto-inst-column (max verilog-auto-inst-column
(+ 16 (* 8 (/ (+ indent-pt 7) 8)))))
+ (verilog-auto-inst-first-any t)
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
submod submodi submoddecls
- inst skip-pins tpl-list tpl-num did-first)
+ inst skip-pins tpl-list tpl-num)
;; Find module name that is instantiated
(setq submod (save-excursion
;; Get to the point where AUTOINST normally is to read the module
@@ -12060,14 +12130,13 @@ Templates:
(when regexp
(setq sig-list (verilog-signals-matching-regexp sig-list regexp)))
(when sig-list
- (when (not did-first) (verilog-auto-inst-first) (setq did-first t))
;; Note these are searched for in verilog-read-sub-decls.
- (verilog-insert-indent "// Parameters\n")
- (verilog-auto-inst-port-list sig-list indent-pt moddecls
+ (verilog-auto-inst-port-list "// Parameters\n"
+ sig-list indent-pt moddecls
tpl-list tpl-num nil nil)))
;; Kill extra semi
(save-excursion
- (cond (did-first
+ (cond ((not verilog-auto-inst-first-any)
(re-search-backward "," pt t)
(delete-char 1)
(insert ")")
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 39819131010..f288facba50 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -2304,10 +2304,6 @@ Ignore byte-compiler warnings you might see."
(defvaralias 'vhdl-last-input-event 'last-input-char)
(defvaralias 'vhdl-last-input-event 'last-input-event))
-;; `help-print-return-message' changed to `print-help-return-message' in Emacs
-;;;(unless (fboundp 'help-print-return-message)
-;;; (defalias 'help-print-return-message 'print-help-return-message))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Compatibility with older VHDL Mode versions
@@ -5340,9 +5336,6 @@ Key bindings:
(defvar vhdl-reserved-words-regexp nil
"Regexp for additional reserved words.")
-(defvar vhdl-directive-keywords-regexp nil
- "Regexp for compiler directive keywords.")
-
(defun vhdl-upcase-list (condition list)
"Upcase all elements in LIST based on CONDITION."
(when condition
@@ -5420,9 +5413,6 @@ Key bindings:
(concat vhdl-forbidden-syntax "\\|"))
(regexp-opt vhdl-reserved-words)
"\\)\\>"))
- (setq vhdl-directive-keywords-regexp
- (concat "\\<\\(" (mapconcat 'regexp-quote
- vhdl-directive-keywords "\\|") "\\)\\>"))
(vhdl-abbrev-list-init))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -13635,7 +13625,10 @@ This does background highlighting of translate-off regions.")
vhdl-template-prompt-syntax ">\\)")
2 'vhdl-font-lock-prompt-face t)
(list (concat "--\\s-*"
- vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$")
+ "\\<"
+ (regexp-opt vhdl-directive-keywords t)
+ "\\>"
+ "\\s-+\\(.*\\)$")
2 'vhdl-font-lock-directive-face t)
;; highlight c-preprocessor directives
(list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?"
@@ -16148,7 +16141,7 @@ expansion function)."
;; initialize speedbar
(if (not (boundp 'speedbar-frame))
- (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)
+ (with-no-warnings (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize))
(vhdl-speedbar-initialize)
(when speedbar-frame (vhdl-speedbar-refresh)))
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 1cee552b0c0..266f40abbae 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -186,7 +186,7 @@ and you want to simplify them for the mode line
"Non-nil means display current function name in mode line.
This makes a difference only if `which-function-mode' is non-nil.")
-(add-hook 'find-file-hook 'which-func-ff-hook t)
+(add-hook 'after-change-major-mode-hook 'which-func-ff-hook t)
(defun which-func-try-to-enable ()
(unless (or (not which-function-mode)
@@ -195,7 +195,7 @@ This makes a difference only if `which-function-mode' is non-nil.")
(member major-mode which-func-modes)))))
(defun which-func-ff-hook ()
- "File find hook for Which Function mode.
+ "`after-change-major-mode-hook' for Which Function mode.
It creates the Imenu index for the buffer, if necessary."
(which-func-try-to-enable)
@@ -282,52 +282,55 @@ If no function name is found, return nil."
(when (null name)
(setq name (add-log-current-defun)))
;; If Imenu is loaded, try to make an index alist with it.
+ ;; If `add-log-current-defun' ran and gave nil, accept that.
(when (and (null name)
- (boundp 'imenu--index-alist)
- (or (null imenu--index-alist)
- ;; Update if outdated
- (/= (buffer-chars-modified-tick) imenu-menubar-modified-tick))
- (null which-function-imenu-failed))
- (ignore-errors (imenu--make-index-alist t))
- (unless imenu--index-alist
- (set (make-local-variable 'which-function-imenu-failed) t)))
- ;; If we have an index alist, use it.
- (when (and (null name)
- (boundp 'imenu--index-alist) imenu--index-alist)
- (let ((alist imenu--index-alist)
- (minoffset (point-max))
- offset pair mark imstack namestack)
- ;; Elements of alist are either ("name" . marker), or
- ;; ("submenu" ("name" . marker) ... ). The list can be
- ;; arbitrarily nested.
- (while (or alist imstack)
- (if (null alist)
- (setq alist (car imstack)
- namestack (cdr namestack)
- imstack (cdr imstack))
-
- (setq pair (car-safe alist)
- alist (cdr-safe alist))
-
- (cond
- ((atom pair)) ; Skip anything not a cons.
-
- ((imenu--subalist-p pair)
- (setq imstack (cons alist imstack)
- namestack (cons (car pair) namestack)
- alist (cdr pair)))
-
- ((or (number-or-marker-p (setq mark (cdr pair)))
- (and (overlayp mark)
- (setq mark (overlay-start mark))))
- (when (and (>= (setq offset (- (point) mark)) 0)
- (< offset minoffset)) ; Find the closest item.
- (setq minoffset offset
- name (if (null which-func-imenu-joiner-function)
- (car pair)
- (funcall
- which-func-imenu-joiner-function
- (reverse (cons (car pair) namestack))))))))))))
+ (null add-log-current-defun-function))
+ (when (and (null name)
+ (boundp 'imenu--index-alist)
+ (or (null imenu--index-alist)
+ ;; Update if outdated
+ (/= (buffer-chars-modified-tick) imenu-menubar-modified-tick))
+ (null which-function-imenu-failed))
+ (ignore-errors (imenu--make-index-alist t))
+ (unless imenu--index-alist
+ (set (make-local-variable 'which-function-imenu-failed) t)))
+ ;; If we have an index alist, use it.
+ (when (and (null name)
+ (boundp 'imenu--index-alist) imenu--index-alist)
+ (let ((alist imenu--index-alist)
+ (minoffset (point-max))
+ offset pair mark imstack namestack)
+ ;; Elements of alist are either ("name" . marker), or
+ ;; ("submenu" ("name" . marker) ... ). The list can be
+ ;; arbitrarily nested.
+ (while (or alist imstack)
+ (if (null alist)
+ (setq alist (car imstack)
+ namestack (cdr namestack)
+ imstack (cdr imstack))
+
+ (setq pair (car-safe alist)
+ alist (cdr-safe alist))
+
+ (cond
+ ((atom pair)) ; Skip anything not a cons.
+
+ ((imenu--subalist-p pair)
+ (setq imstack (cons alist imstack)
+ namestack (cons (car pair) namestack)
+ alist (cdr pair)))
+
+ ((or (number-or-marker-p (setq mark (cdr pair)))
+ (and (overlayp mark)
+ (setq mark (overlay-start mark))))
+ (when (and (>= (setq offset (- (point) mark)) 0)
+ (< offset minoffset)) ; Find the closest item.
+ (setq minoffset offset
+ name (if (null which-func-imenu-joiner-function)
+ (car pair)
+ (funcall
+ which-func-imenu-joiner-function
+ (reverse (cons (car pair) namestack)))))))))))))
;; Filter the name if requested.
(when name
(if which-func-cleanup-function
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index c36a9bd9940..e1dd6e56bbf 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,6 +1,11 @@
-;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
+;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Version: 1.0.3
+;; Package-Requires: ((emacs "26.3"))
+
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -258,17 +263,24 @@ be found, return nil.
The default implementation uses `semantic-symref-tool-alist' to
find a search tool; by default, this uses \"find | grep\" in the
-`project-current' roots."
- (cl-mapcan
+current project's main and external roots."
+ (mapcan
(lambda (dir)
(xref-references-in-directory identifier dir))
(let ((pr (project-current t)))
- (append
- (project-roots pr)
+ (cons
+ (if (fboundp 'project-root)
+ (project-root pr)
+ (with-no-warnings
+ (project-roots pr)))
(project-external-roots pr)))))
(cl-defgeneric xref-backend-apropos (backend pattern)
- "Find all symbols that match regexp PATTERN.")
+ "Find all symbols that match PATTERN string.
+The second argument has the same meaning as in `apropos'.
+
+If BACKEND is implemented in Lisp, it can use
+`xref-apropos-regexp' to convert the pattern to regexp.")
(cl-defgeneric xref-backend-identifier-at-point (_backend)
"Return the relevant identifier at point.
@@ -588,15 +600,18 @@ SELECT is `quit', also quit the *xref* window."
(defun xref-goto-xref (&optional quit)
"Jump to the xref on the current line and select its window.
-Non-interactively, non-nil QUIT means to first quit the *xref*
-buffer."
- (interactive)
+Non-interactively, non-nil QUIT, or interactively, with prefix argument
+means to first quit the *xref* buffer."
+ (interactive "P")
(let* ((buffer (current-buffer))
(xref (or (xref--item-at-point)
(user-error "No reference at point")))
(xref--current-item xref))
(xref--show-location (xref-item-location xref) (if quit 'quit t))
- (next-error-found buffer (current-buffer))))
+ (if (fboundp 'next-error-found)
+ (next-error-found buffer (current-buffer))
+ ;; Emacs < 27
+ (setq next-error-last-buffer buffer))))
(defun xref-quit-and-goto-xref ()
"Quit *xref* buffer, then jump to xref on current line."
@@ -946,8 +961,18 @@ Accepts the same arguments as `xref-show-xrefs-function'."
(defvar xref--read-pattern-history nil)
-(defun xref--show-xrefs (fetcher display-action)
+(defun xref--show-xrefs (fetcher display-action &optional _always-show-list)
(xref--push-markers)
+ (unless (functionp fetcher)
+ ;; Old convention.
+ (let ((xrefs fetcher))
+ (setq fetcher
+ (lambda ()
+ (if (eq xrefs 'called-already)
+ (user-error "Refresh is not supported")
+ (prog1
+ xrefs
+ (setq xrefs 'called-already)))))))
(funcall xref-show-xrefs-function fetcher
`((window . ,(selected-window))
(display-action . ,display-action))))
@@ -1093,14 +1118,24 @@ The argument has the same meaning as in `apropos'."
"Search for pattern (word list or regexp): "
nil 'xref--read-pattern-history)))
(require 'apropos)
- (xref--find-xrefs pattern 'apropos
- (apropos-parse-pattern
- (if (string-equal (regexp-quote pattern) pattern)
- ;; Split into words
- (or (split-string pattern "[ \t]+" t)
- (user-error "No word list given"))
- pattern))
- nil))
+ (let* ((newpat
+ (if (and (version< emacs-version "28.0.50")
+ (memq (xref-find-backend) '(elisp etags)))
+ ;; Handle backends in older Emacs.
+ (xref-apropos-regexp pattern)
+ ;; Delegate pattern handling to the backend fully.
+ ;; The old way didn't work for "external" backends.
+ pattern)))
+ (xref--find-xrefs pattern 'apropos newpat nil)))
+
+(defun xref-apropos-regexp (pattern)
+ "Return an Emacs regexp from PATTERN similar to `apropos'."
+ (apropos-parse-pattern
+ (if (string-equal (regexp-quote pattern) pattern)
+ ;; Split into words
+ (or (split-string pattern "[ \t]+" t)
+ (user-error "No word list given"))
+ pattern)))
;;; Key bindings
@@ -1262,13 +1297,13 @@ FILES must be a list of absolute file names."
(insert (mapconcat #'identity files "\0"))
(setq default-directory dir)
(setq status
- (project--process-file-region (point-min)
- (point-max)
- shell-file-name
- output
- nil
- shell-command-switch
- command)))
+ (xref--process-file-region (point-min)
+ (point-max)
+ shell-file-name
+ output
+ nil
+ shell-command-switch
+ command)))
(goto-char (point-min))
(when (and (/= (point-min) (point-max))
(not (looking-at grep-re))
@@ -1283,6 +1318,24 @@ FILES must be a list of absolute file names."
hits)))
(xref--convert-hits (nreverse hits) regexp)))
+(defun xref--process-file-region ( start end program
+ &optional buffer display
+ &rest args)
+ ;; FIXME: This branching shouldn't be necessary, but
+ ;; call-process-region *is* measurably faster, even for a program
+ ;; doing some actual work (for a period of time). Even though
+ ;; call-process-region also creates a temp file internally
+ ;; (https://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html).
+ (if (not (file-remote-p default-directory))
+ (apply #'call-process-region
+ start end program nil buffer display args)
+ (let ((infile (make-temp-file "ppfr")))
+ (unwind-protect
+ (progn
+ (write-region start end infile nil 'silent)
+ (apply #'process-file program infile buffer display args))
+ (delete-file infile)))))
+
(defun xref--rgrep-command (regexp files dir ignores)
(require 'find-dired) ; for `find-name-arg'
(defvar grep-find-template)
@@ -1317,11 +1370,11 @@ directory, used as the root of the ignore globs."
(lambda (ignore)
(when (string-match-p "/\\'" ignore)
(setq ignore (concat ignore "*")))
- (if (string-match "\\`\\./" ignore)
- (setq ignore (replace-match dir t t ignore))
- (unless (string-prefix-p "*" ignore)
- (setq ignore (concat "*/" ignore))))
- (shell-quote-argument ignore))
+ (shell-quote-argument (if (string-match "\\`\\./" ignore)
+ (replace-match dir t t ignore)
+ (if (string-prefix-p "*" ignore)
+ ignore
+ (concat "*/" ignore)))))
ignores
" -o -path ")
" "
@@ -1364,8 +1417,8 @@ Such as the current syntax table and the applied syntax properties."
(let (xref--last-file-buffer
(tmp-buffer (generate-new-buffer " *xref-temp*")))
(unwind-protect
- (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp tmp-buffer))
- hits)
+ (mapcan (lambda (hit) (xref--collect-matches hit regexp tmp-buffer))
+ hits)
(kill-buffer tmp-buffer))))
(defun xref--collect-matches (hit regexp tmp-buffer)
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index 8dfb3a40dd1..c6997862f7f 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -446,8 +446,6 @@ Entry to this mode runs `scheme-mode-hook' and then
(scheme-interaction-mode-initialize)
(scheme-interaction-mode t)))))
-(define-obsolete-function-alias 'advertised-xscheme-send-previous-expression
- 'xscheme-send-previous-expression "23.2")
;;;; Debugger Mode
diff --git a/lisp/ps-def.el b/lisp/ps-def.el
index 49d72d3be50..571e1a68c5e 100644
--- a/lisp/ps-def.el
+++ b/lisp/ps-def.el
@@ -5,7 +5,7 @@
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Kenichi Handa <handa@gnu.org> (multi-byte characters)
;; Keywords: wp, print, PostScript
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; Package: ps-print
;; This file is part of GNU Emacs.
@@ -55,24 +55,14 @@
(face-background face nil t))
-(defalias 'ps-frame-parameter 'frame-parameter)
+(define-obsolete-function-alias 'ps-frame-parameter #'frame-parameter "28.1")
;; Return t if the device (which can be changed during an emacs session) can
-;; handle colors. This function is not yet implemented for GNU emacs.
+;; handle colors.
(defun ps-color-device ()
- (if (fboundp 'color-values)
- (funcall 'color-values "Green")
- t))
-
-
-(defun ps-color-values (x-color)
- (cond
- ((fboundp 'color-values)
- (funcall 'color-values x-color))
- ((fboundp 'x-color-values)
- (funcall 'x-color-values x-color))
- (t
- (error "No available function to determine X color values"))))
+ (color-values "Green"))
+
+(define-obsolete-function-alias 'ps-color-values #'color-values "28.1")
(defun ps-face-bold-p (face)
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index aade09214c0..351c489f487 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -9,7 +9,7 @@
;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
;; Version: 7.3.5
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
(eval-when-compile (require 'cl-lib))
@@ -3856,7 +3856,7 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'."
(defun ps-color-scale (color)
;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
(mapcar #'(lambda (value) (/ value ps-print-color-scale))
- (ps-color-values color)))
+ (color-values color)))
(defun ps-face-underlined-p (face)
@@ -4523,7 +4523,7 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
(let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
(buffer-name)))
".ps"))
- (prompt (format "Save PostScript to file (default %s): " name))
+ (prompt (format-prompt "Save PostScript to file" name))
(res (read-file-name prompt default-directory name nil)))
(while (cond ((file-directory-p res)
(ding)
@@ -5752,7 +5752,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
;; evaluated at dump-time because X isn't initialized.
ps-color-p (and ps-print-color-p (ps-color-device))
ps-print-color-scale (if ps-color-p
- (float (car (ps-color-values "white")))
+ (float (car (color-values "white")))
1.0)
ps-default-background (ps-rgb-color
(cond
@@ -5761,7 +5761,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(eq genfunc 'ps-generate-postscript))
nil)
((eq ps-default-bg 'frame-parameter)
- (ps-frame-parameter nil 'background-color))
+ (frame-parameter nil 'background-color))
((eq ps-default-bg t)
(ps-face-background-name 'default))
(t
@@ -5775,7 +5775,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(eq genfunc 'ps-generate-postscript))
nil)
((eq ps-default-fg 'frame-parameter)
- (ps-frame-parameter nil 'foreground-color))
+ (frame-parameter nil 'foreground-color))
((eq ps-default-fg t)
(ps-face-foreground-name 'default))
(t
@@ -6275,10 +6275,6 @@ If FACE is not a valid face name, use default face."
(goto-char to))
-;; Ensure that face-list is fbound.
-(or (fboundp 'face-list) (defalias 'face-list 'list-faces))
-
-
(defun ps-build-reference-face-lists ()
(setq ps-print-face-alist nil)
(if ps-auto-font-detect
diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el
index 656ad3e79b8..c5dcf494c0b 100644
--- a/lisp/ps-samp.el
+++ b/lisp/ps-samp.el
@@ -8,7 +8,7 @@
;; Kenichi Handa <handa@gnu.org> (multi-byte characters)
;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; Package: ps-print
;; This file is part of GNU Emacs.
diff --git a/lisp/recentf.el b/lisp/recentf.el
index b636e594864..61c39de12b2 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -245,7 +245,10 @@ The following values can be set:
- A number
Cleanup each time Emacs has been idle that number of seconds.
- A time string
- Cleanup at specified time string, for example at \"11:00pm\".
+ Cleanup at specified time string daily, for example at \"11:00pm\".
+
+If a time string is provided and it is already past the specified time
+for the current day, the first cleanup happens immediately as for `mode'.
Setting this variable directly does not take effect;
use \\[customize].
@@ -257,7 +260,7 @@ cleanup the list."
:value mode)
(const :tag "Never"
:value never)
- (number :tag "When idle that seconds"
+ (number :tag "When idle after (seconds)"
:value 300)
(string :tag "At time"
:value "11:00pm"))
@@ -277,6 +280,8 @@ If `file-name-history' is not empty, do nothing."
"Normal hook run at end of loading the `recentf' package."
:group 'recentf
:type 'hook)
+(make-obsolete-variable 'recentf-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom recentf-filename-handlers nil
"Functions to post process recent file names.
@@ -369,7 +374,8 @@ See also the option `recentf-auto-cleanup'.")
recentf-auto-cleanup t 'recentf-cleanup))
((stringp recentf-auto-cleanup)
(run-at-time
- recentf-auto-cleanup nil 'recentf-cleanup))))))
+ ;; Repeat every 24 hours.
+ recentf-auto-cleanup (* 24 60 60) 'recentf-cleanup))))))
;;; File functions
;;
@@ -1287,7 +1293,8 @@ Write data into the file specified by `recentf-save-file'."
(insert "\n \n;; Local Variables:\n"
(format ";; coding: %s\n" recentf-save-file-coding-system)
";; End:\n")
- (write-file (expand-file-name recentf-save-file))
+ (write-region (point-min) (point-max)
+ (expand-file-name recentf-save-file))
(when recentf-save-file-modes
(set-file-modes recentf-save-file recentf-save-file-modes))
nil)
diff --git a/lisp/rect.el b/lisp/rect.el
index 9922aac9ec9..ebf309a88fe 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -521,8 +521,9 @@ Called from a program, takes three args; START, END and STRING."
#'rectangle--string-erase-preview nil t)
(add-hook 'post-command-hook
#'rectangle--string-preview nil t))
- (read-string (format "String rectangle (default %s): "
- (or (car string-rectangle-history) ""))
+ (read-string (format-prompt
+ "String rectangle"
+ (or (car string-rectangle-history) ""))
nil 'string-rectangle-history
(car string-rectangle-history)
'inherit-input-method))))))
@@ -549,8 +550,8 @@ This command does not delete or overwrite any existing text."
(list
(region-beginning)
(region-end)
- (read-string (format "String insert rectangle (default %s): "
- (or (car string-rectangle-history) ""))
+ (read-string (format-prompt "String insert rectangle"
+ (or (car string-rectangle-history) ""))
nil 'string-rectangle-history
(car string-rectangle-history)))))
(apply-on-rectangle 'string-rectangle-line start end string nil))
diff --git a/lisp/registry.el b/lisp/registry.el
index 7d95d91ad2c..ef47f07aec5 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -317,7 +317,7 @@ Errors out if the key exists already."
(message "reindexing: %d of %d (%.2f%%)"
count expected (/ (* 100.0 count) expected)))
(dolist (val (cdr-safe (assq tr v)))
- (let* ((value-keys (registry-lookup-secondary-value db tr val)))
+ (let ((value-keys (registry-lookup-secondary-value db tr val)))
(push key value-keys)
(registry-lookup-secondary-value db tr val value-keys))))
(oref db data))))))
diff --git a/lisp/repeat.el b/lisp/repeat.el
index db33b083386..1dabd76e071 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -4,7 +4,7 @@
;; Author: Will Mengarini <seldon@eskimo.com>
;; Created: Mo 02 Mar 98
-;; Version: 0.51
+;; Old-Version: 0.51
;; Keywords: convenience, vi, repeat
;; This file is part of GNU Emacs.
@@ -85,10 +85,6 @@
;; C-x { shrink-window-horizontally
;; C-x } enlarge-window-horizontally
-;; This command was first called `vi-dot', because
-;; it was inspired by the `.' command in the vi editor,
-;; but it was renamed to make its name more meaningful.
-
;;; Code:
;;;;; ************************* USER OPTIONS ************************** ;;;;;
diff --git a/lisp/replace.el b/lisp/replace.el
index 0880cbdb1ea..3a2ab1d24c8 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -126,6 +126,18 @@ This variable affects only `query-replace-regexp'."
:type 'boolean
:group 'matching)
+(defcustom query-replace-highlight-submatches t
+ "Whether to highlight regexp subexpressions during query replacement.
+The faces used to do the highlights are named `isearch-group-1',
+`isearch-group-2', etc. (By default, only these 2 are defined.)
+When there are more matches than faces, then faces are reused from the
+beginning, in a cyclical manner, so the `isearch-group-1' face is
+isreused for the third match. If you want to use more distinctive colors,
+you can define more of these faces using the same numbering scheme."
+ :type 'boolean
+ :group 'matching
+ :version "28.1")
+
(defcustom query-replace-lazy-highlight t
"Controls the lazy-highlighting during query replacements.
When non-nil, all text in the buffer matching the current match
@@ -208,12 +220,15 @@ wants to replace FROM with TO."
(minibuffer-allow-text-properties t) ; separator uses text-properties
(prompt
(cond ((and query-replace-defaults separator)
- (format "%s (default %s): " prompt (car minibuffer-history)))
+ (format-prompt prompt (car minibuffer-history)))
(query-replace-defaults
- (format "%s (default %s -> %s): " prompt
- (query-replace-descr (caar query-replace-defaults))
- (query-replace-descr (cdar query-replace-defaults))))
- (t (format "%s: " prompt))))
+ (format-prompt
+ prompt (format "%s -> %s"
+ (query-replace-descr
+ (caar query-replace-defaults))
+ (query-replace-descr
+ (cdar query-replace-defaults)))))
+ (t (format-prompt prompt nil))))
(from
;; The save-excursion here is in case the user marks and copies
;; a region in order to specify the minibuffer input.
@@ -757,6 +772,13 @@ which will run faster and will not set the mark or print anything."
Maximum length of the history list is determined by the value
of `history-length', which see.")
+(defvar occur-highlight-regexp t
+ "Regexp matching part of visited source lines to highlight temporarily.
+Highlight entire line if t; don't highlight source lines if nil.")
+
+(defvar occur-highlight-overlay nil
+ "Overlay used to temporarily highlight occur matches.")
+
(defvar occur-collect-regexp-history '("\\1")
"History of regexp for occur's collect operation")
@@ -884,7 +906,8 @@ and `search-upper-case' is non-nil, the matching is case-sensitive.
Second and third arg RSTART and REND specify the region to operate on.
This command operates on (the accessible part of) all lines whose
accessible part is entirely contained in the region determined by RSTART
-and REND. (A newline ending a line counts as part of that line.)
+and REND. (A newline ending a line counts as part of that line.) If RSTART
+is non-nil, REND also has to be given.
Interactively, in Transient Mark mode when the mark is active, operate
on all lines whose accessible part is entirely contained in the region.
@@ -1113,6 +1136,8 @@ a previously found match."
(define-key map "\C-m" 'occur-mode-goto-occurrence)
(define-key map "o" 'occur-mode-goto-occurrence-other-window)
(define-key map "\C-o" 'occur-mode-display-occurrence)
+ (define-key map "n" 'next-error-no-select)
+ (define-key map "p" 'previous-error-no-select)
(define-key map "\M-n" 'occur-next)
(define-key map "\M-p" 'occur-prev)
(define-key map "r" 'occur-rename-buffer)
@@ -1261,9 +1286,12 @@ If not invoked by a mouse click, go to occurrence on the current line."
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion
(goto-char (posn-point (event-end event)))
- (occur-mode-find-occurrence))))))
+ (occur-mode-find-occurrence)))))
+ (regexp occur-highlight-regexp))
(pop-to-buffer (marker-buffer pos))
(goto-char pos)
+ (let ((end-mk (save-excursion (re-search-forward regexp nil t))))
+ (occur--highlight-occurrence pos end-mk))
(when buffer (next-error-found buffer (current-buffer)))
(run-hooks 'occur-mode-find-occurrence-hook)))
@@ -1277,17 +1305,74 @@ If not invoked by a mouse click, go to occurrence on the current line."
(next-error-found buffer (current-buffer))
(run-hooks 'occur-mode-find-occurrence-hook)))
+;; Stolen from compile.el
+(defun occur-goto-locus-delete-o ()
+ (delete-overlay occur-highlight-overlay)
+ ;; Get rid of timer and hook that would try to do this again.
+ (if (timerp next-error-highlight-timer)
+ (cancel-timer next-error-highlight-timer))
+ (remove-hook 'pre-command-hook
+ #'occur-goto-locus-delete-o))
+
+;; Highlight the current visited occurrence.
+;; Adapted from `compilation-goto-locus'.
+(defun occur--highlight-occurrence (mk end-mk)
+ (let ((highlight-regexp occur-highlight-regexp))
+ (if (timerp next-error-highlight-timer)
+ (cancel-timer next-error-highlight-timer))
+ (unless occur-highlight-overlay
+ (setq occur-highlight-overlay
+ (make-overlay (point-min) (point-min)))
+ (overlay-put occur-highlight-overlay 'face 'next-error))
+ (with-current-buffer (marker-buffer mk)
+ (save-excursion
+ (if end-mk (goto-char end-mk) (end-of-line))
+ (let ((end (point)))
+ (if mk (goto-char mk) (beginning-of-line))
+ (if (and (stringp highlight-regexp)
+ (re-search-forward highlight-regexp end t))
+ (progn
+ (goto-char (match-beginning 0))
+ (move-overlay occur-highlight-overlay
+ (match-beginning 0) (match-end 0)
+ (current-buffer)))
+ (move-overlay occur-highlight-overlay
+ (point) end (current-buffer)))
+ (if (or (eq next-error-highlight t)
+ (numberp next-error-highlight))
+ ;; We want highlighting: delete overlay on next input.
+ (add-hook 'pre-command-hook
+ #'occur-goto-locus-delete-o)
+ ;; We don't want highlighting: delete overlay now.
+ (delete-overlay occur-highlight-overlay))
+ ;; We want highlighting for a limited time:
+ ;; set up a timer to delete it.
+ (when (numberp next-error-highlight)
+ (setq next-error-highlight-timer
+ (run-at-time next-error-highlight nil
+ 'occur-goto-locus-delete-o))))))
+ (when (eq next-error-highlight 'fringe-arrow)
+ ;; We want a fringe arrow (instead of highlighting).
+ (setq next-error-overlay-arrow-position
+ (copy-marker (line-beginning-position))))))
+
(defun occur-mode-display-occurrence ()
"Display in another window the occurrence the current line describes."
(interactive)
(let ((buffer (current-buffer))
(pos (occur-mode-find-occurrence))
+ (regexp occur-highlight-regexp)
+ (next-error-highlight next-error-highlight-no-select)
+ (display-buffer-overriding-action
+ '(nil (inhibit-same-window . t)))
window)
(setq window (display-buffer (marker-buffer pos) t))
;; This is the way to set point in the proper window.
(save-selected-window
(select-window window)
(goto-char pos)
+ (let ((end-mk (save-excursion (re-search-forward regexp nil t))))
+ (occur--highlight-occurrence pos end-mk))
(next-error-found buffer (current-buffer))
(run-hooks 'occur-mode-find-occurrence-hook))))
@@ -1418,7 +1503,7 @@ which means to discard all text properties."
;; Get the regexp for collection pattern.
(let ((default (car occur-collect-regexp-history)))
(read-regexp
- (format "Regexp to collect (default %s): " default)
+ (format-prompt "Regexp to collect" default)
default 'occur-collect-regexp-history)))
;; Otherwise normal occur takes numerical prefix argument.
(when current-prefix-arg
@@ -1500,6 +1585,19 @@ is not modified."
(defvar ido-ignore-item-temp-list)
+(defun multi-occur--prompt ()
+ (concat
+ "Next buffer to search "
+ (cond
+ ((or (eq read-buffer-function #'ido-read-buffer)
+ (bound-and-true-p ido-everywhere))
+ (substitute-command-keys
+ "(\\<ido-completion-map>\\[ido-select-text] to end): "))
+ ((bound-and-true-p fido-mode)
+ (substitute-command-keys
+ "(\\<icomplete-fido-mode-map>\\[icomplete-fido-exit] to end): "))
+ (t "(RET to end): "))))
+
(defun multi-occur (bufs regexp &optional nlines)
"Show all lines in buffers BUFS containing a match for REGEXP.
Optional argument NLINES specifies the number of context lines to show
@@ -1515,11 +1613,7 @@ See also `multi-occur-in-matching-buffers'."
(buf nil)
(ido-ignore-item-temp-list bufs))
(while (not (string-equal
- (setq buf (read-buffer
- (if (eq read-buffer-function #'ido-read-buffer)
- "Next buffer to search (C-j to end): "
- "Next buffer to search (RET to end): ")
- nil t))
+ (setq buf (read-buffer (multi-occur--prompt) nil t))
""))
(cl-pushnew buf bufs)
(setq ido-ignore-item-temp-list bufs))
@@ -1583,7 +1677,8 @@ See also `multi-occur'."
(and (overlayp boo)
(overlay-buffer boo)))
boo))
- bufs))))
+ bufs)))
+ (source-buffer-default-directory default-directory))
;; Handle the case where one of the buffers we're searching is the
;; output buffer. Just rename it.
(when (member buf-name
@@ -1600,6 +1695,9 @@ See also `multi-occur'."
(setq occur-buf (get-buffer-create buf-name))
(with-current-buffer occur-buf
+ ;; Make the default-directory of the *Occur* buffer match that of
+ ;; the buffer where the occurrences come from
+ (setq default-directory source-buffer-default-directory)
(if (stringp nlines)
(fundamental-mode) ;; This is for collect operation.
(occur-mode))
@@ -1608,6 +1706,7 @@ See also `multi-occur'."
(buffer-undo-list t)
(occur--final-pos nil))
(erase-buffer)
+ (set (make-local-variable 'occur-highlight-regexp) regexp)
(let ((count
(if (stringp nlines)
;; Treat nlines as a regexp to collect.
@@ -1944,10 +2043,8 @@ See also `multi-occur'."
global-matches)))
(defun occur-engine-line (beg end &optional keep-props)
- (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
- (text-property-not-all beg end 'fontified t))
- (if (fboundp 'jit-lock-fontify-now)
- (jit-lock-fontify-now beg end)))
+ (if (and keep-props font-lock-mode)
+ (font-lock-ensure beg end))
(if (and keep-props (not (eq occur-excluded-properties t)))
(let ((str (buffer-substring beg end)))
(remove-list-of-text-properties
@@ -2319,6 +2416,7 @@ It is called with three arguments, as if it were
(funcall search-function search-string limit t)))
(defvar replace-overlay nil)
+(defvar replace-submatches-overlays nil)
(defun replace-highlight (match-beg match-end range-beg range-end
search-string regexp-flag delimited-flag
@@ -2329,6 +2427,25 @@ It is called with three arguments, as if it were
(setq replace-overlay (make-overlay match-beg match-end))
(overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
(overlay-put replace-overlay 'face 'query-replace)))
+
+ (when (and query-replace-highlight-submatches
+ regexp-flag)
+ (mapc 'delete-overlay replace-submatches-overlays)
+ (setq replace-submatches-overlays nil)
+ (let ((submatch-data (cddr (butlast (match-data t))))
+ (group 0)
+ ov face)
+ (while submatch-data
+ (setq group (1+ group))
+ (setq ov (make-overlay (pop submatch-data) (pop submatch-data))
+ face (intern-soft (format "isearch-group-%d" group)))
+ ;; Recycle faces from beginning.
+ (unless (facep face)
+ (setq group 1 face 'isearch-group-1))
+ (overlay-put ov 'face face)
+ (overlay-put ov 'priority 1002)
+ (push ov replace-submatches-overlays))))
+
(if query-replace-lazy-highlight
(let ((isearch-string search-string)
(isearch-regexp regexp-flag)
@@ -2349,6 +2466,9 @@ It is called with three arguments, as if it were
(defun replace-dehighlight ()
(when replace-overlay
(delete-overlay replace-overlay))
+ (when query-replace-highlight-submatches
+ (mapc 'delete-overlay replace-submatches-overlays)
+ (setq replace-submatches-overlays nil))
(when query-replace-lazy-highlight
(lazy-highlight-cleanup lazy-highlight-cleanup)
(setq isearch-lazy-highlight-last-string nil))
@@ -2878,6 +2998,8 @@ characters."
(replace-dehighlight)
(save-excursion (recursive-edit))
(setq replaced t))
+ ((commandp def t)
+ (call-interactively def))
;; Note: we do not need to treat `exit-prefix'
;; specially here, since we reread
;; any unrecognized character.
diff --git a/lisp/reposition.el b/lisp/reposition.el
index 4788e6ee81e..7561cc4c5f3 100644
--- a/lisp/reposition.el
+++ b/lisp/reposition.el
@@ -1,4 +1,4 @@
-;;; reposition.el --- center a Lisp function or comment on the screen
+;;; reposition.el --- center a Lisp function or comment on the screen -*- lexical-binding: t -*-
;; Copyright (C) 1991, 1994, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 92b80071f71..f9e38646349 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -60,6 +60,13 @@
:type 'boolean
:group 'reveal)
+(defcustom reveal-auto-hide t
+ "Automatically hide revealed text when leaving it.
+If nil, the `reveal-hide-revealed' command can be useful to hide
+revealed text manually."
+ :type 'boolean
+ :version "28.1")
+
(defvar reveal-open-spots nil
"List of spots in the buffer which are open.
Each element has the form (WINDOW . OVERLAY).")
@@ -97,7 +104,8 @@ Each element has the form (WINDOW . OVERLAY).")
(cdr x))))
reveal-open-spots))))
(setq old-ols (reveal-open-new-overlays old-ols))
- (reveal-close-old-overlays old-ols)))))
+ (when reveal-auto-hide
+ (reveal-close-old-overlays old-ols))))))
(defun reveal-open-new-overlays (old-ols)
(let ((repeat t))
@@ -196,6 +204,14 @@ Each element has the form (WINDOW . OVERLAY).")
(delq (rassoc ol reveal-open-spots)
reveal-open-spots)))))))
+(defun reveal-hide-revealed ()
+ "Hide all revealed text.
+If there is revealed text under point, this command does not hide
+that text."
+ (interactive)
+ (let ((reveal-auto-hide t))
+ (reveal-post-command)))
+
(defvar reveal-mode-map
(let ((map (make-sparse-keymap)))
;; Override the default move-beginning-of-line and move-end-of-line
@@ -209,7 +225,9 @@ Each element has the form (WINDOW . OVERLAY).")
"Toggle uncloaking of invisible text near point (Reveal mode).
Reveal mode is a buffer-local minor mode. When enabled, it
-reveals invisible text around point."
+reveals invisible text around point.
+
+Also see the `reveal-auto-hide' variable."
:group 'reveal
:lighter (global-reveal-mode nil " Reveal")
:keymap reveal-mode-map
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index f6b49b46e3f..82e6178da14 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -4,7 +4,7 @@
;; Author: David Ponce <david@dponce.com>
;; Created: 24 Mar 2001
-;; Version: 1.6
+;; Old-Version: 1.6
;; Keywords: convenience
;; This file is part of GNU Emacs.
diff --git a/lisp/savehist.el b/lisp/savehist.el
index fcfdb47c7e8..5d20239d17f 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -4,8 +4,8 @@
;; Author: Hrvoje Nikšić <hrvoje.niksic@avl.com>
;; Maintainer: emacs-devel@gnu.org
-;; Keywords: minibuffer
-;; Version: 24
+;; Keywords: convenience, minibuffer
+;; Old-Version: 24
;; This file is part of GNU Emacs.
@@ -27,7 +27,7 @@
;; Many editors (e.g. Vim) have the feature of saving minibuffer
;; history to an external file after exit. This package provides the
;; same feature in Emacs. When set up, it saves recorded minibuffer
-;; histories to a file (`~/.emacs-history' by default). Additional
+;; histories to a file (`~/.emacs.d/history' by default). Additional
;; variables may be specified by customizing
;; `savehist-additional-variables'.
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index fa0e181bb10..d420bfb4e9f 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -1,4 +1,4 @@
-;;; saveplace.el --- automatically save place in files
+;;; saveplace.el --- automatically save place in files -*- lexical-binding:t -*-
;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
@@ -42,7 +42,6 @@
"Automatically save place in files."
:group 'data)
-
(defvar save-place-alist nil
"Alist of saved places to go back to when revisiting files.
Each element looks like (FILENAME . POSITION);
@@ -175,10 +174,11 @@ file:
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(defun save-place-to-alist ()
- ;; put filename and point in a cons box and then cons that onto the
- ;; front of the save-place-alist, if save-place-mode is non-nil.
- ;; Otherwise, just delete that file from the alist.
- ;; first check to make sure alist has been loaded in from the master
+ "Add current buffer filename and position to `save-place-alist'.
+Put filename and point in a cons box and then cons that onto the
+front of the `save-place-alist', if `save-place-mode' is non-nil.
+Otherwise, just delete that file from the alist."
+ ;; First check to make sure alist has been loaded in from the master
;; file. If not, do so, then feel free to modify the alist. It
;; will be saved again when Emacs is killed.
(or save-place-loaded (load-save-place-alist-from-file))
@@ -248,8 +248,8 @@ may have changed) back to `save-place-alist'."
(delete-region (point-min) (point-max))
(when save-place-forget-unreadable-files
(save-place-forget-unreadable-files))
- (insert (format ";;; -*- coding: %s -*-\n"
- (symbol-name coding-system-for-write)))
+ (insert (format ";;; -*- coding: %s; mode: lisp-data -*-\n"
+ coding-system-for-write))
(let ((print-length nil)
(print-level nil))
(pp save-place-alist (current-buffer)))
diff --git a/lisp/sb-image.el b/lisp/sb-image.el
deleted file mode 100644
index 1e8b1057bc8..00000000000
--- a/lisp/sb-image.el
+++ /dev/null
@@ -1,107 +0,0 @@
-;;; sb-image --- Image management for speedbar
-
-;; Copyright (C) 1999-2003, 2005-2020 Free Software Foundation, Inc.
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Keywords: file, tags, tools
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Supporting Image display for Emacs 20 and less, Emacs 21, and XEmacs,
-;; is a challenging task, which doesn't take kindly to being byte compiled.
-;; When sharing speedbar.elc between these three applications, the Image
-;; support can get lost.
-;;
-;; By splitting out that hard part into this file, and avoiding byte
-;; compilation, one copy speedbar can support all these platforms together.
-;;
-;; This file requires the `image' package if it is available.
-
-(require 'ezimage)
-
-;;; Code:
-(defcustom speedbar-use-images ezimage-use-images
- "Non-nil if speedbar should display icons."
- :group 'speedbar
- :version "21.1"
- :type 'boolean)
-
-(defalias 'defimage-speedbar 'defezimage)
-
-(defvar speedbar-expand-image-button-alist
- '(("<+>" . ezimage-directory-plus)
- ("<->" . ezimage-directory-minus)
- ("< >" . ezimage-directory)
- ("[+]" . ezimage-page-plus)
- ("[-]" . ezimage-page-minus)
- ("[?]" . ezimage-page)
- ("[ ]" . ezimage-page)
- ("{+}" . ezimage-box-plus)
- ("{-}" . ezimage-box-minus)
- ("<M>" . ezimage-mail)
- ("<d>" . ezimage-document-tag)
- ("<i>" . ezimage-info-tag)
- (" =>" . ezimage-tag)
- (" +>" . ezimage-tag-gt)
- (" ->" . ezimage-tag-v)
- (">" . ezimage-tag)
- ("@" . ezimage-tag-type)
- (" @" . ezimage-tag-type)
- ("*" . ezimage-checkout)
- ("#" . ezimage-object)
- ("!" . ezimage-object-out-of-date)
- ("//" . ezimage-label)
- ("%" . ezimage-lock)
- )
- "List of text and image associations.")
-
-(defun speedbar-insert-image-button-maybe (start length)
- "Insert an image button based on text starting at START for LENGTH chars.
-If buttontext is unknown, just insert that text.
-If we have an image associated with it, use that image."
- (when speedbar-use-images
- (let ((ezimage-expand-image-button-alist
- speedbar-expand-image-button-alist))
- (ezimage-insert-image-button-maybe start length))))
-
-(defun speedbar-image-dump ()
- "Dump out the current state of the Speedbar image alist.
-See `speedbar-expand-image-button-alist' for details."
- (interactive)
- (with-output-to-temp-buffer "*Speedbar Images*"
- (with-current-buffer "*Speedbar Images*"
- (goto-char (point-max))
- (insert "Speedbar image cache.\n\n")
- (let ((start (point)) (end nil))
- (insert "Image\tText\tImage Name")
- (setq end (point))
- (insert "\n")
- (put-text-property start end 'face 'underline))
- (let ((ia speedbar-expand-image-button-alist))
- (while ia
- (let ((start (point)))
- (insert (car (car ia)))
- (insert "\t")
- (speedbar-insert-image-button-maybe start
- (length (car (car ia))))
- (insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n"))
- (setq ia (cdr ia)))))))
-
-(provide 'sb-image)
-
-;;; sb-image.el ends here
diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el
index 3a6d9d36429..f20ea1bcc87 100644
--- a/lisp/scroll-lock.el
+++ b/lisp/scroll-lock.el
@@ -1,4 +1,4 @@
-;;; scroll-lock.el --- Scroll lock scrolling.
+;;; scroll-lock.el --- Scroll lock scrolling. -*- lexical-binding:t -*-
;; Copyright (C) 2005-2020 Free Software Foundation, Inc.
diff --git a/lisp/server.el b/lisp/server.el
index e6d8b1783c9..763f651fefc 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -274,10 +274,11 @@ the \"-f\" switch otherwise."
(if internal--daemon-sockname
(file-name-directory internal--daemon-sockname)
(and (featurep 'make-network-process '(:family local))
- (let ((xdg_runtime_dir (getenv "XDG_RUNTIME_DIR")))
- (if xdg_runtime_dir
- (format "%s/emacs" xdg_runtime_dir)
- (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid))))))
+ (let ((runtime-dir (getenv "XDG_RUNTIME_DIR")))
+ (if runtime-dir
+ (expand-file-name "emacs" runtime-dir)
+ (expand-file-name (format "emacs%d" (user-uid))
+ (or (getenv "TMPDIR") "/tmp"))))))
"The directory in which to place the server socket.
If local sockets are not supported, this is nil.")
@@ -353,9 +354,11 @@ Updates `server-clients'."
(setq server-clients (delq proc server-clients))
- ;; Delete the client's tty, except on Windows (both GUI and console),
- ;; where there's only one terminal and does not make sense to delete it.
- (unless (eq system-type 'windows-nt)
+ ;; Delete the client's tty, except on Windows (both GUI and
+ ;; console), where there's only one terminal and does not make
+ ;; sense to delete it, or if we are explicitly told not.
+ (unless (or (eq system-type 'windows-nt)
+ (process-get proc 'no-delete-terminal))
(let ((terminal (process-get proc 'terminal)))
;; Only delete the terminal if it is non-nil.
(when (and terminal (eq (terminal-live-p terminal) t))
@@ -563,7 +566,7 @@ See variable `server-auth-dir' for details."
(format "it is not owned by you (owner = %s (%d))"
(user-full-name uid) uid))
(w32 nil) ; on NTFS?
- ((let ((modes (file-modes dir)))
+ ((let ((modes (file-modes dir 'nofollow)))
(unless (zerop (logand (or modes 0) #o077))
(format "it is accessible by others (%03o)" modes))))
(t nil))))
@@ -727,7 +730,8 @@ If server is running, it is first stopped.
NAME defaults to `server-name'. With argument, ask for NAME."
(interactive
(list (if current-prefix-arg
- (read-string "Server name: " nil nil server-name))))
+ (read-string (format-prompt "Server name" server-name)
+ nil nil server-name))))
(when server-mode (with-temp-message nil (server-mode -1)))
(let ((file (expand-file-name (or name server-name)
(if server-use-tcp
@@ -828,7 +832,6 @@ This handles splitting the command if it would be bigger than
(error "Invalid terminal device"))
(unless type
(error "Invalid terminal type"))
- (add-to-list 'frame-inherited-parameters 'client)
(let ((frame
(server-with-environment
(process-get proc 'env)
@@ -840,32 +843,19 @@ This handles splitting the command if it would be bigger than
"TERMINFO_DIRS" "TERMPATH"
;; rxvt wants these
"COLORFGBG" "COLORTERM")
- (make-frame `((window-system . nil)
- (tty . ,tty)
- (tty-type . ,type)
- ;; Ignore nowait here; we always need to
- ;; clean up opened ttys when the client dies.
- (client . ,proc)
- ;; This is a leftover from an earlier
- ;; attempt at making it possible for process
- ;; run in the server process to use the
- ;; environment of the client process.
- ;; It has no effect now and to make it work
- ;; we'd need to decide how to make
- ;; process-environment interact with client
- ;; envvars, and then to change the
- ;; C functions `child_setup' and
- ;; `getenv_internal' accordingly.
- (environment . ,(process-get proc 'env))
- ,@parameters)))))
+ (server--create-frame
+ ;; Ignore nowait here; we always need to
+ ;; clean up opened ttys when the client dies.
+ nil proc
+ `((window-system . nil)
+ (tty . ,tty)
+ (tty-type . ,type)
+ ,@parameters)))))
;; ttys don't use the `display' parameter, but callproc.c does to set
;; the DISPLAY environment on subprocesses.
(set-frame-parameter frame 'display
(getenv-internal "DISPLAY" (process-get proc 'env)))
- (select-frame frame)
- (process-put proc 'frame frame)
- (process-put proc 'terminal (frame-terminal frame))
frame))
(defun server-create-window-system-frame (display nowait proc parent-id
@@ -891,31 +881,56 @@ This handles splitting the command if it would be bigger than
)
(cond (w
- ;; Flag frame as client-created, but use a dummy client.
- ;; This will prevent the frame from being deleted when
- ;; emacsclient quits while also preventing
- ;; `server-save-buffers-kill-terminal' from unexpectedly
- ;; killing emacs on that frame.
- (let* ((params `((client . ,(if nowait 'nowait proc))
- ;; This is a leftover, see above.
- (environment . ,(process-get proc 'env))
- ,@parameters))
- frame)
- (if parent-id
- (push (cons 'parent-id (string-to-number parent-id)) params))
- (add-to-list 'frame-inherited-parameters 'client)
- (setq frame (make-frame-on-display display params))
- (server-log (format "%s created" frame) proc)
- (select-frame frame)
- (process-put proc 'frame frame)
- (process-put proc 'terminal (frame-terminal frame))
- frame))
+ (server--create-frame
+ nowait proc
+ `((display . ,display)
+ ,@(if parent-id
+ `((parent-id . ,(string-to-number parent-id))))
+ ,@parameters)))
(t
(server-log "Window system unsupported" proc)
(server-send-string proc "-window-system-unsupported \n")
nil))))
+(defun server-create-dumb-terminal-frame (nowait proc &optional parameters)
+ ;; If the destination is a dumb terminal, we can't really run Emacs
+ ;; in its tty. So instead, we use whichever terminal is currently
+ ;; selected. This situation typically occurs when `emacsclient' is
+ ;; running inside something like an Emacs shell buffer (bug#25547).
+ (let ((frame (server--create-frame nowait proc parameters)))
+ ;; The client is not the exclusive owner of this terminal, so don't
+ ;; delete the terminal when the client exits.
+ ;; FIXME: Maybe we just shouldn't set the `terminal' property instead?
+ (process-put proc 'no-delete-terminal t)
+ frame))
+
+(defun server--create-frame (nowait proc parameters)
+ (add-to-list 'frame-inherited-parameters 'client)
+ ;; When `nowait' is set, flag frame as client-created, but use
+ ;; a dummy client. This will prevent the frame from being deleted
+ ;; when emacsclient quits while also preventing
+ ;; `server-save-buffers-kill-terminal' from unexpectedly killing
+ ;; emacs on that frame.
+ (let ((frame (make-frame `((client . ,(if nowait 'nowait proc))
+ ;; This is a leftover from an earlier
+ ;; attempt at making it possible for process
+ ;; run in the server process to use the
+ ;; environment of the client process.
+ ;; It has no effect now and to make it work
+ ;; we'd need to decide how to make
+ ;; process-environment interact with client
+ ;; envvars, and then to change the
+ ;; C functions `child_setup' and
+ ;; `getenv_internal' accordingly.
+ (environment . ,(process-get proc 'env))
+ ,@parameters))))
+ (server-log (format "%s created" frame) proc)
+ (select-frame frame)
+ (process-put proc 'frame frame)
+ (process-put proc 'terminal (frame-terminal frame))
+ frame))
+
(defun server-goto-toplevel (proc)
(condition-case nil
;; If we're running isearch, we must abort it to allow Emacs to
@@ -1262,6 +1277,9 @@ The following commands are accepted by the client:
terminal-frame)))))
(setq tty-name nil tty-type nil)
(if display (server-select-display display)))
+ ((equal tty-type "dumb")
+ (server-create-dumb-terminal-frame nowait proc
+ frame-parameters))
((or (and (eq system-type 'windows-nt)
(daemonp)
(setq display "w32"))
@@ -1336,7 +1354,13 @@ The following commands are accepted by the client:
"When done with this frame, type \\[delete-frame]")))
((not (null buffers))
(run-hooks 'server-after-make-frame-hook)
- (server-switch-buffer (car buffers) nil (cdr (car files)))
+ (server-switch-buffer
+ (car buffers) nil (cdr (car files))
+ ;; When triggered from "emacsclient -c", we popped up a
+ ;; new frame. Ensure that we switch to the requested
+ ;; buffer in that frame, and not in some other frame
+ ;; where it may be displayed.
+ (plist-get (process-plist proc) 'frame))
(run-hooks 'server-switch-hook)
(unless nowait
(message "%s" (substitute-command-keys
@@ -1566,7 +1590,8 @@ starts server process and that is all. Invoked by \\[server-edit]."
(server-clients (apply #'server-switch-buffer (server-done)))
(t (message "No server editing buffers exist"))))
-(defun server-switch-buffer (&optional next-buffer killed-one filepos)
+(defun server-switch-buffer (&optional next-buffer killed-one filepos
+ this-frame-only)
"Switch to another buffer, preferably one that has a client.
Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it.
@@ -1600,7 +1625,8 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)."
;; OK, we know next-buffer is live, let's display and select it.
(if (functionp server-window)
(funcall server-window next-buffer)
- (let ((win (get-buffer-window next-buffer 0)))
+ (let ((win (get-buffer-window next-buffer
+ (if this-frame-only nil 0))))
(if (and win (not server-window))
;; The buffer is already displayed: just reuse the
;; window. If FILEPOS is non-nil, use it to replace the
@@ -1618,7 +1644,8 @@ be a cons cell (LINENUMBER . COLUMNNUMBER)."
(setq server-window (make-frame)))
(select-window (frame-selected-window server-window))))
(when (window-minibuffer-p)
- (select-window (next-window nil 'nomini 0)))
+ (select-window (next-window nil 'nomini
+ (if this-frame-only nil 0))))
;; Move to a non-dedicated window, if we have one.
(when (window-dedicated-p)
(select-window
diff --git a/lisp/ses.el b/lisp/ses.el
index b3811afd71a..bfafc132bf5 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -2540,10 +2540,8 @@ cell formula was unsafe and user declined confirmation."
(if (equal initial "\"")
(progn
(if (not (stringp curval)) (setq curval nil))
- (read-string (if curval
- (format "String Cell %s (default %s): "
- ses--curcell curval)
- (format "String Cell %s: " ses--curcell))
+ (read-string (format-prompt "String Cell %s"
+ curval ses--curcell)
nil 'ses-read-string-history curval))
(read-from-minibuffer
(format "Cell %s: " ses--curcell)
@@ -3007,9 +3005,9 @@ inserts a new row if at bottom of print area. Repeat COUNT times."
(list col
(if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
- (read-from-minibuffer (format "Column %s width (default %d): "
- (ses-column-letter col)
- (ses-col-width col))
+ (read-from-minibuffer (format-prompt "Column %s width"
+ (ses-col-width col)
+ (ses-column-letter col))
nil ; No initial contents.
nil ; No override keymap.
t ; Convert to Lisp object.
@@ -3674,7 +3672,7 @@ highlighted range in the spreadsheet."
;; 'rowcol' corresponding to 'ses-cell' property of symbol
;; 'sym'. Both must be the same.
(unless (eq sym old-name)
- (error "Spreadsheet is broken, both symbols %S and %S refering to cell (%d,%d)" sym old-name row col))
+ (error "Spreadsheet is broken, both symbols %S and %S referring to cell (%d,%d)" sym old-name row col))
(if new-rowcol
;; the new name is of A1 type, so we test that the coordinate
;; inferred from new name
@@ -3687,7 +3685,7 @@ highlighted range in the spreadsheet."
(puthash new-name rowcol ses--named-cell-hashmap))
(push `(ses-rename-cell ,old-name ,cell) buffer-undo-list)
(cl-pushnew rowcol ses--deferred-write :test #'equal)
- ;; Replace name by new name in formula of cells refering to renamed cell.
+ ;; Replace name by new name in formula of cells referring to renamed cell.
(dolist (ref (ses-cell-references cell))
(let* ((x (ses-sym-rowcol ref))
(xcell (ses-get-cell (car x) (cdr x))))
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 6bea5e22567..a7343a9f943 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -524,10 +524,9 @@ call it manually."
(if (called-interactively-p 'interactive)
(message "No files need to be shadowed."))
(save-excursion
- (map-y-or-n-p (function
- (lambda (pair)
- (or arg shadow-noquery
- (format "Copy shadow file %s? " (cdr pair)))))
+ (map-y-or-n-p (lambda (pair)
+ (or arg shadow-noquery
+ (format "Copy shadow file %s? " (cdr pair))))
(function shadow-copy-file)
shadow-files-to-copy
'("shadow" "shadows" "copy"))
@@ -540,11 +539,11 @@ them again, unless you make more changes to the files. To cancel a shadow
permanently, remove the group from `shadow-literal-groups' or
`shadow-regexp-groups'."
(interactive)
- (map-y-or-n-p (function (lambda (pair)
- (format "Cancel copying %s to %s? "
- (car pair) (cdr pair))))
- (function (lambda (pair)
- (shadow-remove-from-todo pair)))
+ (map-y-or-n-p (lambda (pair)
+ (format "Cancel copying %s to %s? "
+ (car pair) (cdr pair)))
+ (lambda (pair)
+ (shadow-remove-from-todo pair))
shadow-files-to-copy
'("shadow" "shadows" "cancel copy"))
(message "There are %d shadows to be updated."
@@ -601,8 +600,8 @@ and to are absolute file names."
shadow-homedir))
(canonical-file (shadow-contract-file-name absolute-file))
(shadows
- (mapcar (function (lambda (shadow)
- (cons absolute-file shadow)))
+ (mapcar (lambda (shadow)
+ (cons absolute-file shadow))
(append
(shadow-shadows-of-1
canonical-file shadow-literal-groups nil)
@@ -632,9 +631,8 @@ Consider them as regular expressions if third arg REGEXP is true."
"shadow-shadows-of-1: %s %s %s"
file (shadow-parse-name file) realname))
(mapcar
- (function
- (lambda (x)
- (shadow-replace-name-component x realname)))
+ (lambda (x)
+ (shadow-replace-name-component x realname))
nonmatching)))
(t nonmatching))
(shadow-shadows-of-1 file (cdr groups) regexp)))))
@@ -791,9 +789,8 @@ look for files that have been changed and need to be copied to other systems."
(save-some-buffers arg t)
(shadow-copy-files)
(shadow-save-todo-file)
- (and (or (not (memq t (mapcar (function
- (lambda (buf) (and (buffer-file-name buf)
- (buffer-modified-p buf))))
+ (and (or (not (memq t (mapcar (lambda (buf) (and (buffer-file-name buf)
+ (buffer-modified-p buf)))
(buffer-list))))
(yes-or-no-p "Modified buffers exist; exit anyway? "))
(or (not (fboundp 'process-list))
diff --git a/lisp/shell.el b/lisp/shell.el
index dc1198b7bac..43ad58774b8 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -249,7 +249,7 @@ This mirrors the optional behavior of tcsh."
(defcustom shell-chdrive-regexp
(if (memq system-type '(ms-dos windows-nt))
; NetWare allows the five chars between upper and lower alphabetics.
- "[]a-zA-Z^_`\\[\\\\]:"
+ "[]a-zA-Z^_`[\\]:"
nil)
"If non-nil, is regexp used to track drive changes."
:type '(choice regexp
@@ -334,6 +334,7 @@ Thus, this does not include the shell's current directory.")
(define-key map "\t" 'completion-at-point)
(define-key map (kbd "M-RET") 'shell-resync-dirs)
(define-key map "\M-?" 'comint-dynamic-list-filename-completions)
+ (define-key map (kbd "C-x n d") 'shell-narrow-to-prompt)
(define-key map [menu-bar completion]
(cons "Complete"
(copy-keymap (lookup-key comint-mode-map [menu-bar completion]))))
@@ -374,7 +375,7 @@ Thus, this does not include the shell's current directory.")
"\\|\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)"
"\\|{\\(?1:[^{}]+\\)}\\)"
(when (memq system-type '(ms-dos windows-nt))
- "\\|%\\(?1:[^\\\\/]*\\)%")
+ "\\|%\\(?1:[^\\/]*\\)%")
(when comint-file-name-quote-list
"\\|\\\\\\(.\\)")))
(qupos nil)
@@ -460,9 +461,12 @@ Thus, this does not include the shell's current directory.")
This is the value of `pcomplete-command-completion-function' for
Shell buffers. It implements `shell-completion-execonly' for
`pcomplete' completion."
- (pcomplete-here (pcomplete-entries nil
- (if shell-completion-execonly
- 'file-executable-p))))
+ (if (pcomplete-match "/")
+ (pcomplete-here (pcomplete-entries nil
+ (if shell-completion-execonly
+ 'file-executable-p)))
+ (pcomplete-here
+ (nth 2 (shell--command-completion-data)))))
(defun shell-completion-vars ()
"Setup completion vars for `shell-mode' and `read-shell-command'."
@@ -619,7 +623,12 @@ buffer."
;; Bypass a bug in certain versions of bash.
(when (string-equal shell "bash")
(add-hook 'comint-preoutput-filter-functions
- #'shell-filter-ctrl-a-ctrl-b nil t)))
+ #'shell-filter-ctrl-a-ctrl-b nil t))
+
+ ;; Skip extended history for zsh.
+ (when (string-equal shell "zsh")
+ (setq-local comint-input-ring-file-prefix
+ ": [[:digit:]]+:[[:digit:]]+;")))
(comint-read-input-ring t)))
(defun shell-apply-ansi-color (beg end face)
@@ -985,9 +994,6 @@ this feature; see the function `dirtrack-mode'."
(add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t)
(remove-hook 'comint-input-filter-functions #'shell-directory-tracker t)))
-(define-obsolete-function-alias 'shell-dirtrack-toggle #'shell-dirtrack-mode
- "23.1")
-
(defun shell-cd (dir)
"Do normal `cd' to DIR, and set `list-buffers-directory'."
(cd dir)
@@ -1033,25 +1039,41 @@ command again."
(accept-process-output proc)
(goto-char pt)))
(goto-char pmark) (delete-char 1) ; remove the extra newline
- ;; That's the dirlist. grab it & parse it.
- (let* ((dl (buffer-substring (match-beginning 2) (1- (match-end 2))))
- (dl-len (length dl))
- (ds '()) ; new dir stack
- (i 0))
- (while (< i dl-len)
- ;; regexp = optional whitespace, (non-whitespace), optional whitespace
- (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
- (setq ds (cons (concat comint-file-name-prefix
- (substring dl (match-beginning 1)
- (match-end 1)))
- ds))
- (setq i (match-end 0)))
- (let ((ds (nreverse ds)))
- (with-demoted-errors "Couldn't cd: %s"
- (shell-cd (car ds))
- (setq shell-dirstack (cdr ds)
- shell-last-dir (car shell-dirstack))
- (shell-dirstack-message)))))
+ ;; That's the dirlist. Grab it & parse it.
+ (let* ((dls (buffer-substring-no-properties
+ (match-beginning 0) (1- (match-end 0))))
+ (dlsl nil)
+ (pos 0)
+ (ds nil))
+ ;; Split the dirlist into whitespace and non-whitespace chunks.
+ ;; dlsl will be a reversed list of tokens.
+ (while (string-match "\\(\\S-+\\|\\s-+\\)" dls pos)
+ (push (match-string 1 dls) dlsl)
+ (setq pos (match-end 1)))
+
+ ;; Prepend trailing entries until they form an existing directory,
+ ;; whitespace and all. Discard the next whitespace and repeat.
+ (while dlsl
+ (let ((newelt "")
+ tem1 tem2)
+ (while newelt
+ ;; We need tem1 because we don't want to prepend
+ ;; `comint-file-name-prefix' repeatedly into newelt via tem2.
+ (setq tem1 (pop dlsl)
+ tem2 (concat comint-file-name-prefix tem1 newelt))
+ (cond ((file-directory-p tem2)
+ (push tem2 ds)
+ (when (string= " " (car dlsl))
+ (pop dlsl))
+ (setq newelt nil))
+ (t
+ (setq newelt (concat tem1 newelt)))))))
+
+ (with-demoted-errors "Couldn't cd: %s"
+ (shell-cd (car ds))
+ (setq shell-dirstack (cdr ds)
+ shell-last-dir (car shell-dirstack))
+ (shell-dirstack-message))))
(if started-at-pmark (goto-char (marker-position pmark)))))
;; For your typing convenience:
@@ -1187,7 +1209,7 @@ Returns t if successful."
(cwd (file-name-as-directory (expand-file-name default-directory)))
(ignored-extensions
(and comint-completion-fignore
- (mapconcat (function (lambda (x) (concat (regexp-quote x) "\\'")))
+ (mapconcat (lambda (x) (concat (regexp-quote x) "\\'"))
comint-completion-fignore "\\|")))
(dir "") (comps-in-dir ())
(file "") (abs-file-name "") (completions ()))
@@ -1345,6 +1367,48 @@ Returns t if successful."
(let ((f (shell-c-a-p-replace-by-expanded-directory)))
(if f (funcall f))))
+(defun shell--prompt-begin-position ()
+ ;; We need this convoluted function because `looking-at-p' does not work on
+ ;; multiline regexps _and_ `re-search-backward' skips the current line.
+ (save-excursion
+ (let ((old-point (point)))
+ (max
+ (save-excursion
+ ;; Right result if not on prompt.
+ (call-interactively #'comint-previous-prompt)
+ (re-search-backward comint-prompt-regexp)
+ (point))
+ (save-excursion
+ ;; Right result if on first char after prompt.
+ (re-search-backward comint-prompt-regexp)
+ (point))
+ (save-excursion
+ ;; Right result if on prompt.
+ (call-interactively #'comint-next-prompt)
+ (re-search-backward comint-prompt-regexp)
+ (if (<= (point) old-point)
+ (point)
+ (point-min)))))))
+
+(defun shell--prompt-end-position ()
+ (save-excursion
+ (goto-char (shell--prompt-begin-position))
+ (comint-next-prompt 1)
+ (point)))
+
+(defun shell-narrow-to-prompt ()
+ "Narrow buffer to the command line (and any following command output) at point."
+ (interactive)
+ (let ((begin (shell--prompt-begin-position)))
+ (narrow-to-region
+ begin
+ (save-excursion
+ (goto-char (shell--prompt-end-position))
+ (call-interactively #'comint-next-prompt)
+ (if (= begin (shell--prompt-begin-position))
+ (point-max)
+ (shell--prompt-begin-position))))))
+
(provide 'shell)
;;; shell.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
index 3ea00d44a03..5158bc74a9c 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -118,6 +118,27 @@ If non-nil, the value is passed directly to `recenter'."
:group 'next-error
:version "23.1")
+(defcustom next-error-message-highlight nil
+ "If non-nil, highlight the current error message in the `next-error' buffer.
+If the value is `keep', highlighting is permanent, so all visited error
+messages are highlighted; this helps to see what messages were visited."
+ :type '(choice (const :tag "Highlight the current error" t)
+ (const :tag "Highlight all visited errors" keep)
+ (const :tag "No highlighting" nil))
+ :group 'next-error
+ :version "28.1")
+
+(defface next-error-message
+ '((t (:inherit highlight :extend t)))
+ "Face used to highlight the current error message in the `next-error' buffer."
+ :group 'next-error
+ :version "28.1")
+
+(defvar next-error--message-highlight-overlay
+ nil
+ "Overlay highlighting the current error message in the `next-error' buffer.")
+(make-variable-buffer-local 'next-error--message-highlight-overlay)
+
(defcustom next-error-hook nil
"List of hook functions run by `next-error' after visiting source file."
:type 'hook
@@ -199,7 +220,7 @@ rejected, and the function returns nil."
(and extra-test-inclusive
(funcall extra-test-inclusive))))))
-(defcustom next-error-find-buffer-function #'next-error-buffer-unnavigated-current
+(defcustom next-error-find-buffer-function #'ignore
"Function called to find a `next-error' capable buffer.
This functions takes the same three arguments as the function
`next-error-find-buffer', and should return the buffer to be
@@ -215,7 +236,7 @@ all other buffers."
next-error-buffer-unnavigated-current)
(function :tag "Other function"))
:group 'next-error
- :version "27.1")
+ :version "28.1")
(defcustom next-error-found-function #'ignore
"Function called when a next locus is found and displayed.
@@ -376,6 +397,7 @@ and TO-BUFFER is a target buffer."
(when next-error-recenter
(recenter next-error-recenter))
(funcall next-error-found-function from-buffer to-buffer)
+ (next-error-message-highlight from-buffer)
(run-hooks 'next-error-hook))
(defun next-error-select-buffer (buffer)
@@ -460,6 +482,20 @@ buffer causes automatic display of the corresponding source code location."
(next-error-no-select 0))
(error t))))
+(defun next-error-message-highlight (error-buffer)
+ "Highlight the current error message in the ‘next-error’ buffer."
+ (when next-error-message-highlight
+ (with-current-buffer error-buffer
+ (when (and next-error--message-highlight-overlay
+ (not (eq next-error-message-highlight 'keep)))
+ (delete-overlay next-error--message-highlight-overlay))
+ (let ((ol (make-overlay (line-beginning-position) (1+ (line-end-position)))))
+ ;; do not override region highlighting
+ (overlay-put ol 'priority -50)
+ (overlay-put ol 'face 'next-error-message)
+ (overlay-put ol 'window (get-buffer-window))
+ (setf next-error--message-highlight-overlay ol)))))
+
;;;
@@ -516,7 +552,7 @@ This hook is run by `delete-selection-uses-region-p', which see.")
"Propertized string representing a hard newline character.")
(defun newline (&optional arg interactive)
- "Insert a newline, and move to left margin of the new line if it's blank.
+ "Insert a newline, and move to left margin of the new line.
With prefix argument ARG, insert that many newlines.
If `electric-indent-mode' is enabled, this indents the final new line
@@ -553,7 +589,7 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
(save-excursion
(goto-char beforepos)
(beginning-of-line)
- (and (looking-at "[ \t]$")
+ (and (looking-at "[ \t]+$")
(> (current-left-margin) 0)
(delete-region (point)
(line-end-position))))
@@ -1098,7 +1134,11 @@ is supplied, or Transient Mark mode is enabled and the mark is active."
;; If the end of the buffer is not already on the screen,
;; then scroll specially to put it near, but not at, the bottom.
(overlay-recenter (point))
- (recenter -3))))
+ ;; FIXME: Arguably if `scroll-conservatively' is set, then
+ ;; we should pass -1 to `recenter'.
+ (recenter (if (and scroll-minibuffer-conservatively
+ (window-minibuffer-p))
+ -1 -3)))))
(defcustom delete-active-region t
"Whether single-char deletion commands delete an active region.
@@ -1227,7 +1267,47 @@ that uses or sets the mark."
;; Counting lines, one way or another.
-(defun goto-line (line &optional buffer)
+(defvar goto-line-history nil
+ "History of values entered with `goto-line'.")
+(make-variable-buffer-local 'goto-line-history)
+
+(defun goto-line-read-args (&optional relative)
+ "Read arguments for `goto-line' related commands."
+ (if (and current-prefix-arg (not (consp current-prefix-arg)))
+ (list (prefix-numeric-value current-prefix-arg))
+ ;; Look for a default, a number in the buffer at point.
+ (let* ((default
+ (save-excursion
+ (skip-chars-backward "0-9")
+ (if (looking-at "[0-9]")
+ (string-to-number
+ (buffer-substring-no-properties
+ (point)
+ (progn (skip-chars-forward "0-9")
+ (point)))))))
+ ;; Decide if we're switching buffers.
+ (buffer
+ (if (consp current-prefix-arg)
+ (other-buffer (current-buffer) t)))
+ (buffer-prompt
+ (if buffer
+ (concat " in " (buffer-name buffer))
+ "")))
+ ;; Read the argument, offering that number (if any) as default.
+ (list (read-number (format "Goto%s line%s: "
+ (if (buffer-narrowed-p)
+ (if relative " relative" " absolute")
+ "")
+ buffer-prompt)
+ (list default (if (or relative (not (buffer-narrowed-p)))
+ (line-number-at-pos)
+ (save-restriction
+ (widen)
+ (line-number-at-pos))))
+ 'goto-line-history)
+ buffer))))
+
+(defun goto-line (line &optional buffer relative)
"Go to LINE, counting from line 1 at beginning of buffer.
If called interactively, a numeric prefix argument specifies
LINE; without a numeric prefix argument, read LINE from the
@@ -1237,6 +1317,13 @@ If optional argument BUFFER is non-nil, switch to that buffer and
move to line LINE there. If called interactively with \\[universal-argument]
as argument, BUFFER is the most recently selected other buffer.
+If optional argument RELATIVE is non-nil, counting starts at the beginning
+of the accessible portion of the (potentially narrowed) buffer.
+
+If the variable `widen-automatically' is non-nil, cancel narrowing and
+leave all lines accessible. If `widen-automatically' is nil, just move
+point to the edge of visible portion and don't change the buffer bounds.
+
Prior to moving point, this function sets the mark (without
activating it), unless Transient Mark mode is enabled and the
mark is already active.
@@ -1248,31 +1335,7 @@ What you probably want instead is something like:
If at all possible, an even better solution is to use char counts
rather than line counts."
(declare (interactive-only forward-line))
- (interactive
- (if (and current-prefix-arg (not (consp current-prefix-arg)))
- (list (prefix-numeric-value current-prefix-arg))
- ;; Look for a default, a number in the buffer at point.
- (let* ((default
- (save-excursion
- (skip-chars-backward "0-9")
- (if (looking-at "[0-9]")
- (string-to-number
- (buffer-substring-no-properties
- (point)
- (progn (skip-chars-forward "0-9")
- (point)))))))
- ;; Decide if we're switching buffers.
- (buffer
- (if (consp current-prefix-arg)
- (other-buffer (current-buffer) t)))
- (buffer-prompt
- (if buffer
- (concat " in " (buffer-name buffer))
- "")))
- ;; Read the argument, offering that number (if any) as default.
- (list (read-number (format "Goto line%s: " buffer-prompt)
- (list default (line-number-at-pos)))
- buffer))))
+ (interactive (goto-line-read-args))
;; Switch to the desired buffer, one way or another.
(if buffer
(let ((window (get-buffer-window buffer)))
@@ -1281,12 +1344,29 @@ rather than line counts."
;; Leave mark at previous position
(or (region-active-p) (push-mark))
;; Move to the specified line number in that buffer.
- (save-restriction
- (widen)
- (goto-char (point-min))
- (if (eq selective-display t)
- (re-search-forward "[\n\C-m]" nil 'end (1- line))
- (forward-line (1- line)))))
+ (let ((pos (save-restriction
+ (unless relative (widen))
+ (goto-char (point-min))
+ (if (eq selective-display t)
+ (re-search-forward "[\n\C-m]" nil 'end (1- line))
+ (forward-line (1- line)))
+ (point))))
+ (when (and (not relative)
+ (buffer-narrowed-p)
+ widen-automatically
+ ;; Position is outside narrowed part of buffer
+ (or (> (point-min) pos) (> pos (point-max))))
+ (widen))
+ (goto-char pos)))
+
+(defun goto-line-relative (line &optional buffer)
+ "Go to LINE, counting from line at (point-min).
+The line number is relative to the accessible portion of the narrowed
+buffer. The argument BUFFER is the same as in the function `goto-line'."
+ (declare (interactive-only forward-line))
+ (interactive (goto-line-read-args t))
+ (with-suppressed-warnings ((interactive-only goto-line))
+ (goto-line line buffer t)))
(defun count-words-region (start end &optional arg)
"Count the number of words in the region.
@@ -1318,7 +1398,9 @@ If called from Lisp, return the number of words between START and
END, without printing any message."
(interactive (list nil nil))
(cond ((not (called-interactively-p 'any))
- (let ((words 0))
+ (let ((words 0)
+ ;; Count across field boundaries. (Bug#41761)
+ (inhibit-field-text-motion t))
(save-excursion
(save-restriction
(narrow-to-region start end)
@@ -1361,28 +1443,47 @@ END, without printing any message."
(message "line %d (narrowed line %d)"
(+ n (line-number-at-pos start) -1) n))))))
-(defun count-lines (start end)
+(defun count-lines (start end &optional ignore-invisible-lines)
"Return number of lines between START and END.
-This is usually the number of newlines between them,
-but can be one more if START is not equal to END
-and the greater of them is not at the start of a line."
+This is usually the number of newlines between them, but can be
+one more if START is not equal to END and the greater of them is
+not at the start of a line.
+
+When IGNORE-INVISIBLE-LINES is non-nil, invisible lines are not
+included in the count."
(save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
- (if (eq selective-display t)
- (save-match-data
- (let ((done 0))
- (while (re-search-forward "[\n\C-m]" nil t 40)
- (setq done (+ 40 done)))
- (while (re-search-forward "[\n\C-m]" nil t 1)
- (setq done (+ 1 done)))
- (goto-char (point-max))
- (if (and (/= start end)
- (not (bolp)))
- (1+ done)
- done)))
- (- (buffer-size) (forward-line (buffer-size)))))))
+ (cond ((and (not ignore-invisible-lines)
+ (eq selective-display t))
+ (save-match-data
+ (let ((done 0))
+ (while (re-search-forward "\n\\|\r[^\n]" nil t 40)
+ (setq done (+ 40 done)))
+ (while (re-search-forward "\n\\|\r[^\n]" nil t 1)
+ (setq done (+ 1 done)))
+ (goto-char (point-max))
+ (if (and (/= start end)
+ (not (bolp)))
+ (1+ done)
+ done))))
+ (ignore-invisible-lines
+ (save-match-data
+ (- (buffer-size)
+ (forward-line (buffer-size))
+ (let ((invisible-count 0)
+ prop)
+ (goto-char (point-min))
+ (while (re-search-forward "\n\\|\r[^\n]" nil t)
+ (setq prop (get-char-property (1- (point)) 'invisible))
+ (if (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))
+ (setq invisible-count (1+ invisible-count))))
+ invisible-count))))
+ (t (- (buffer-size) (forward-line (buffer-size))))))))
(defun line-number-at-pos (&optional pos absolute)
"Return buffer line number at position POS.
@@ -1474,7 +1575,11 @@ in *Help* buffer. See also the command `describe-char'."
encoded encoding-msg display-prop under-display)
(if (or (not coding)
(eq (coding-system-type coding) t))
- (setq coding (default-value 'buffer-file-coding-system)))
+ (setq coding (or (default-value 'buffer-file-coding-system)
+ ;; A nil value of `buffer-file-coding-system'
+ ;; means "no conversion" which means each byte
+ ;; is a char and vice versa.
+ 'binary)))
(if (eq (char-charset char) 'eight-bit)
(setq encoding-msg
(format "(%d, #o%o, #x%x%s, raw-byte)" char char char char-name-fmt))
@@ -1532,6 +1637,8 @@ in *Help* buffer. See also the command `describe-char'."
;; Might as well bind TAB to completion, since inserting a TAB char is
;; much too rarely useful.
(define-key m "\t" 'completion-at-point)
+ (define-key m "\r" 'read--expression-try-read)
+ (define-key m "\n" 'read--expression-try-read)
(set-keymap-parent m minibuffer-local-map)
m))
@@ -1614,11 +1721,18 @@ display the result of expression evaluation."
"Hook run by `eval-expression' when entering the minibuffer.")
(defun read--expression (prompt &optional initial-contents)
+ "Read an Emacs Lisp expression from the minibuffer.
+
+PROMPT and optional argument INITIAL-CONTENTS do the same as in
+function `read-from-minibuffer'."
(let ((minibuffer-completing-symbol t))
(minibuffer-with-setup-hook
(lambda ()
- ;; FIXME: call emacs-lisp-mode (see also
- ;; `eldoc--eval-expression-setup')?
+ ;; FIXME: instead of just applying the syntax table, maybe
+ ;; use a special major mode tailored to reading Lisp
+ ;; expressions from the minibuffer? (`emacs-lisp-mode'
+ ;; doesn't preserve the necessary keybindings.)
+ (set-syntax-table emacs-lisp-mode-syntax-table)
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil t)
(run-hooks 'eval-expression-minibuffer-setup-hook))
@@ -1626,6 +1740,45 @@ display the result of expression evaluation."
read-expression-map t
'read-expression-history))))
+(defun read--expression-try-read ()
+ "Try to read an Emacs Lisp expression in the minibuffer.
+
+Exit the minibuffer if successful, else report the error to the
+user and move point to the location of the error. If point is
+not already at the location of the error, push a mark before
+moving point."
+ (interactive)
+ (unless (> (minibuffer-depth) 0)
+ (error "Minibuffer must be active"))
+ (if (let* ((contents (minibuffer-contents))
+ (error-point nil))
+ (with-temp-buffer
+ (condition-case err
+ (progn
+ (insert contents)
+ (goto-char (point-min))
+ ;; `read' will signal errors like "End of file during
+ ;; parsing" and "Invalid read syntax".
+ (read (current-buffer))
+ ;; Since `read' does not signal the "Trailing garbage
+ ;; following expression" error, we check for trailing
+ ;; garbage ourselves.
+ (or (progn
+ ;; This check is similar to what `string_to_object'
+ ;; does in minibuf.c.
+ (skip-chars-forward " \t\n")
+ (= (point) (point-max)))
+ (error "Trailing garbage following expression")))
+ (error
+ (setq error-point (+ (length (minibuffer-prompt)) (point)))
+ (with-current-buffer (window-buffer (minibuffer-window))
+ (unless (= (point) error-point)
+ (push-mark))
+ (goto-char error-point)
+ (minibuffer-message (error-message-string err)))
+ nil))))
+ (exit-minibuffer)))
+
(defun eval-expression-get-print-arguments (prefix-argument)
"Get arguments for commands that print an expression result.
Returns a list (INSERT-VALUE NO-TRUNCATE CHAR-PRINT-LIMIT)
@@ -1773,9 +1926,15 @@ to get different commands to edit and resubmit."
(lambda ()
;; Get a command name at point in the original buffer
;; to propose it after M-n.
- (with-current-buffer (window-buffer (minibuffer-selected-window))
- (and (commandp (function-called-at-point))
- (format "%S" (function-called-at-point)))))))
+ (let ((def (with-current-buffer
+ (window-buffer (minibuffer-selected-window))
+ (and (commandp (function-called-at-point))
+ (format "%S" (function-called-at-point)))))
+ (all (sort (minibuffer-default-add-completions)
+ #'string<)))
+ (if def
+ (cons def (delete def all))
+ all)))))
;; Read a string, completing from and restricting to the set of
;; all defined commands. Don't provide any initial input.
;; Save the command read on the extended-command history list.
@@ -1797,23 +1956,34 @@ to get different commands to edit and resubmit."
;; and it serves as a shorthand for "Extended command: ".
"M-x ")
(lambda (string pred action)
- (let ((pred
- (if (memq action '(nil t))
- ;; Exclude obsolete commands from completions.
- (lambda (sym)
- (and (funcall pred sym)
- (or (equal string (symbol-name sym))
- (not (get sym 'byte-obsolete-info)))))
- pred)))
+ (if (and suggest-key-bindings (eq action 'metadata))
+ '(metadata
+ (annotation-function . read-extended-command--annotation)
+ (category . command))
(complete-with-action action obarray string pred)))
#'commandp t nil 'extended-command-history)))
+(defun read-extended-command--annotation (command-name)
+ (let* ((fun (and (stringp command-name) (intern-soft command-name)))
+ (binding (where-is-internal fun overriding-local-map t))
+ (obsolete (get fun 'byte-obsolete-info))
+ (alias (symbol-function fun)))
+ (cond ((symbolp alias)
+ (format " (%s)" alias))
+ (obsolete
+ (format " (%s)" (car obsolete)))
+ ((and binding (not (stringp binding)))
+ (format " (%s)" (key-description binding))))))
+
(defcustom suggest-key-bindings t
"Non-nil means show the equivalent key-binding when M-x command has one.
The value can be a length of time to show the message for.
If the value is non-nil and not a number, we wait 2 seconds.
-Also see `extended-command-suggest-shorter'."
+Also see `extended-command-suggest-shorter'.
+
+Equivalent key-bindings are also shown in the completion list of
+M-x for all commands that have them."
:group 'keyboard
:type '(choice (const :tag "off" nil)
(integer :tag "time" 2)
@@ -1939,13 +2109,18 @@ invoking, give a prefix argument to `execute-extended-command'."
;; BEWARE: Called directly from the C code.
"Execute CMD as an editor command.
CMD must be a symbol that satisfies the `commandp' predicate.
-Optional second arg RECORD-FLAG non-nil
-means unconditionally put this command in the variable `command-history'.
-Otherwise, that is done only if an arg is read using the minibuffer.
-The argument KEYS specifies the value to use instead of (this-command-keys)
-when reading the arguments; if it is nil, (this-command-keys) is used.
-The argument SPECIAL, if non-nil, means that this command is executing
-a special event, so ignore the prefix argument and don't clear it."
+
+Optional second arg RECORD-FLAG non-nil means unconditionally put
+this command in the variable `command-history'. Otherwise, that
+is done only if an arg is read using the minibuffer.
+
+The argument KEYS specifies the value to use instead of the
+return value of the `this-command-keys' function when reading the
+arguments; if it is nil, `this-command-keys' is used.
+
+The argument SPECIAL, if non-nil, means that this command is
+executing a special event, so ignore the prefix argument and
+don't clear it."
(setq debug-on-next-call nil)
(let ((prefixarg (unless special
;; FIXME: This should probably be done around
@@ -2036,11 +2211,9 @@ See also `minibuffer-history-case-insensitive-variables'."
(interactive
(let* ((enable-recursive-minibuffers t)
(regexp (read-from-minibuffer
- (format "Previous element matching regexp%s: "
- (if minibuffer-history-search-history
- (format " (default %s)"
- (car minibuffer-history-search-history))
- ""))
+ (format-prompt "Previous element matching regexp"
+ (and minibuffer-history-search-history
+ (car minibuffer-history-search-history)))
nil minibuffer-local-map nil
'minibuffer-history-search-history
(car minibuffer-history-search-history))))
@@ -2323,15 +2496,17 @@ previous element of the minibuffer history in the minibuffer."
(goto-char (1- (minibuffer-prompt-end)))
(current-column))))
(move-to-column old-column))
- ;; Put the cursor at the end of the visual line instead of the
- ;; logical line, so the next `previous-line-or-history-element'
- ;; would move to the previous history element, not to a possible upper
- ;; visual line from the end of logical line in `line-move-visual' mode.
- (end-of-visual-line)
- ;; Since `end-of-visual-line' puts the cursor at the beginning
- ;; of the next visual line, move it one char back to the end
- ;; of the first visual line (bug#22544).
- (unless (eolp) (backward-char 1)))))))
+ (if (not line-move-visual) ; Handle logical lines (bug#42862)
+ (end-of-line)
+ ;; Put the cursor at the end of the visual line instead of the
+ ;; logical line, so the next `previous-line-or-history-element'
+ ;; would move to the previous history element, not to a possible upper
+ ;; visual line from the end of logical line in `line-move-visual' mode.
+ (end-of-visual-line)
+ ;; Since `end-of-visual-line' puts the cursor at the beginning
+ ;; of the next visual line, move it one char back to the end
+ ;; of the first visual line (bug#22544).
+ (unless (eolp) (backward-char 1))))))))
(defun next-complete-history-element (n)
"Get next history element that completes the minibuffer before the point.
@@ -2528,6 +2703,11 @@ A redo record for ordinary undo maps to the following (earlier) undo.")
"Within a run of consecutive undo commands, list remaining to be undone.
If t, we undid all the way to the end of it.")
+(defun undo--last-change-was-undo-p (undo-list)
+ (while (and (consp undo-list) (eq (car undo-list) nil))
+ (setq undo-list (cdr undo-list)))
+ (gethash undo-list undo-equiv-table))
+
(defun undo (&optional arg)
"Undo some previous changes.
Repeat this command to undo more changes.
@@ -2563,12 +2743,7 @@ as an argument limits undo to changes within the current region."
(or (eq pending-undo-list t)
;; If something (a timer or filter?) changed the buffer
;; since the previous command, don't continue the undo seq.
- (let ((list buffer-undo-list))
- (while (eq (car list) nil)
- (setq list (cdr list)))
- ;; If the last undo record made was made by undo
- ;; it shows nothing else happened in between.
- (gethash list undo-equiv-table))))
+ (undo--last-change-was-undo-p buffer-undo-list)))
(setq undo-in-region
(and (or (region-active-p) (and arg (not (numberp arg))))
(not inhibit-region)))
@@ -2658,6 +2833,26 @@ Contrary to `undo', this will not redo a previous undo."
(interactive "*p")
(let ((undo-no-redo t)) (undo arg)))
+(defun undo-redo (&optional arg)
+ "Undo the last ARG undos, i.e., redo the last ARG changes.
+Interactively, ARG is the prefix numeric argument and defaults to 1."
+ (interactive "*p")
+ (cond
+ ((not (undo--last-change-was-undo-p buffer-undo-list))
+ (user-error "No undone changes to redo"))
+ (t
+ (let* ((ul buffer-undo-list)
+ (new-ul
+ (let ((undo-in-progress t))
+ (while (and (consp ul) (eq (car ul) nil))
+ (setq ul (cdr ul)))
+ (primitive-undo arg ul)))
+ (new-pul (undo--last-change-was-undo-p new-ul)))
+ (message "Redo%s" (if undo-in-region " in region" ""))
+ (setq this-command 'undo)
+ (setq pending-undo-list new-pul)
+ (setq buffer-undo-list new-ul)))))
+
(defvar undo-in-progress nil
"Non-nil while performing an undo.
Some change-hooks test this variable to do something different.")
@@ -3329,6 +3524,14 @@ which is defined in the `warnings' library.\n")
(setq buffer-undo-list nil)
t))
+;;;; Shell commands
+
+(defconst shell-command-buffer-name "*Shell Command Output*"
+ "Name of the output buffer for shell commands.")
+
+(defconst shell-command-buffer-name-async "*Async Shell Command*"
+ "Name of the output buffer for asynchronous shell commands.")
+
(defvar shell-command-history nil
"History list for some commands that read shell commands.
@@ -3393,8 +3596,9 @@ to `shell-command-history'."
(defcustom async-shell-command-buffer 'confirm-new-buffer
"What to do when the output buffer is used by another shell command.
This option specifies how to resolve the conflict where a new command
-wants to direct its output to the buffer `*Async Shell Command*',
-but this buffer is already taken by another running shell command.
+wants to direct its output to the buffer whose name is stored
+in `shell-command-buffer-name-async', but that buffer is already
+taken by another running shell command.
The value `confirm-kill-process' is used to ask for confirmation before
killing the already running process and running a new process
@@ -3545,14 +3749,18 @@ whose `car' is BUFFER."
Like `shell-command', but adds `&' at the end of COMMAND
to execute it asynchronously.
-The output appears in the buffer `*Async Shell Command*'.
-That buffer is in shell mode.
+The output appears in the buffer whose name is stored in the
+variable `shell-command-buffer-name-async'. That buffer is in
+shell mode.
You can configure `async-shell-command-buffer' to specify what to do
-when the `*Async Shell Command*' buffer is already taken by another
-running shell command. To run COMMAND without displaying the output
-in a window you can configure `display-buffer-alist' to use the action
-`display-buffer-no-window' for the buffer `*Async Shell Command*'.
+when the buffer specified by `shell-command-buffer-name-async' is
+already taken by another running shell command.
+
+To run COMMAND without displaying the output in a window you can
+configure `display-buffer-alist' to use the action
+`display-buffer-no-window' for the buffer given by
+`shell-command-buffer-name-async'.
In Elisp, you will often be better served by calling `start-process'
directly, since it offers more control and does not impose the use of
@@ -3588,16 +3796,18 @@ If `shell-command-prompt-show-cwd' is non-nil, show the current
directory in the prompt.
If COMMAND ends in `&', execute it asynchronously.
-The output appears in the buffer `*Async Shell Command*'.
-That buffer is in shell mode. You can also use
-`async-shell-command' that automatically adds `&'.
+The output appears in the buffer whose name is specified
+by `shell-command-buffer-name-async'. That buffer is in shell
+mode. You can also use `async-shell-command' that automatically
+adds `&'.
Otherwise, COMMAND is executed synchronously. The output appears in
-the buffer `*Shell Command Output*'. If the output is short enough to
-display in the echo area (which is determined by the variables
-`resize-mini-windows' and `max-mini-window-height'), it is shown
-there, but it is nonetheless available in buffer `*Shell Command
-Output*' even though that buffer is not automatically displayed.
+the buffer named by `shell-command-buffer-name'. If the output is
+short enough to display in the echo area (which is determined by the
+variables `resize-mini-windows' and `max-mini-window-height'), it is
+shown there, but it is nonetheless available in buffer named by
+`shell-command-buffer-name' even though that buffer is not
+automatically displayed.
To specify a coding system for converting non-ASCII characters
in the shell command output, use \\[universal-coding-system-argument] \
@@ -3716,7 +3926,7 @@ impose the use of a shell (with its need to quote arguments)."
(if (string-match "[ \t]*&[ \t]*\\'" command)
;; Command ending with ampersand means asynchronous.
(let* ((buffer (get-buffer-create
- (or output-buffer "*Async Shell Command*")))
+ (or output-buffer shell-command-buffer-name-async)))
(bname (buffer-name buffer))
(proc (get-buffer-process buffer))
(directory default-directory))
@@ -3868,9 +4078,9 @@ and are used only if a pop-up buffer is displayed."
error-buffer display-error-buffer
region-noncontiguous-p)
"Execute string COMMAND in inferior shell with region as input.
-Normally display output (if any) in temp buffer `*Shell Command Output*';
-Prefix arg means replace the region with it. Return the exit code of
-COMMAND.
+Normally display output (if any) in temp buffer specified
+by `shell-command-buffer-name'; prefix arg means replace the region
+with it. Return the exit code of COMMAND.
To specify a coding system for converting non-ASCII characters
in the input and output to the shell command, use \\[universal-coding-system-argument]
@@ -3887,7 +4097,7 @@ in the echo area or in a buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there.
-Otherwise it is displayed in the buffer `*Shell Command Output*'.
+Otherwise it is displayed in the buffer named by `shell-command-buffer-name'.
The output is available in that buffer in both cases.
If there is output and an error, a message about the error
@@ -3897,7 +4107,7 @@ Optional fourth arg OUTPUT-BUFFER specifies where to put the
command's output. If the value is a buffer or buffer name,
erase that buffer and insert the output there; a non-nil value of
`shell-command-dont-erase-buffer' prevent to erase the buffer.
-If the value is nil, use the buffer `*Shell Command Output*'.
+If the value is nil, use the buffer specified by `shell-command-buffer-name'.
Any other non-nil value means to insert the output in the
current buffer after START.
@@ -3945,7 +4155,7 @@ characters."
exit-status)
;; Unless a single contiguous chunk is selected, operate on multiple chunks.
(if region-noncontiguous-p
- (let ((input (concat (funcall region-extract-function 'delete) "\n"))
+ (let ((input (concat (funcall region-extract-function (when replace 'delete)) "\n"))
output)
(with-temp-buffer
(insert input)
@@ -3953,9 +4163,24 @@ characters."
shell-file-name t t
nil shell-command-switch
command)
- (setq output (split-string (buffer-string) "\n")))
- (goto-char start)
- (funcall region-insert-function output))
+ (setq output (split-string (buffer-substring
+ (point-min)
+ ;; Trim the trailing newline.
+ (if (eq (char-before (point-max)) ?\n)
+ (1- (point-max))
+ (point-max)))
+ "\n")))
+ (cond
+ (replace
+ (goto-char start)
+ (funcall region-insert-function output))
+ (t
+ (let ((buffer (get-buffer-create
+ (or output-buffer shell-command-buffer-name))))
+ (with-current-buffer buffer
+ (erase-buffer)
+ (funcall region-insert-function output))
+ (display-message-or-buffer buffer)))))
(if (or replace
(and output-buffer
(not (or (bufferp output-buffer) (stringp output-buffer)))))
@@ -3970,7 +4195,7 @@ characters."
(list t error-file)
t)))
;; It is rude to delete a buffer that the command is not using.
- ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
+ ;; (let ((shell-buffer (get-buffer shell-command-buffer-name)))
;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
;; (kill-buffer shell-buffer)))
;; Don't muck with mark unless REPLACE says we should.
@@ -3978,12 +4203,13 @@ characters."
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
(let ((buffer (get-buffer-create
- (or output-buffer "*Shell Command Output*"))))
+ (or output-buffer shell-command-buffer-name))))
(set-buffer-major-mode buffer) ; Enable globalized modes (bug#38111)
(unwind-protect
(if (and (eq buffer (current-buffer))
(or (memq shell-command-dont-erase-buffer '(nil erase))
- (and (not (eq buffer (get-buffer "*Shell Command Output*")))
+ (and (not (eq buffer (get-buffer
+ shell-command-buffer-name)))
(not (region-active-p)))))
;; If the input is the same buffer as the output,
;; delete everything but the specified region,
@@ -4118,6 +4344,20 @@ its behavior with respect to remote file attribute caching.
You should only ever change this variable with a let-binding;
never with `setq'.")
+(defcustom process-file-return-signal-string nil
+ "Whether to return a string describing the signal interrupting a process.
+When a process returns an exit code greater than 128, it is
+interpreted as a signal. `process-file' requires to return a
+string describing this signal.
+Since there are processes violating this rule, returning exit
+codes greater than 128 which are not bound to a signal,
+`process-file' returns the exit code as natural number also in
+this case. Setting this user option to non-nil forces
+`process-file' to interpret such exit codes as signals, and to
+return a corresponding string."
+ :version "28.1"
+ :type 'boolean)
+
(defun start-file-process (name buffer program &rest program-args)
"Start a program in a subprocess. Return the process object for it.
@@ -4215,7 +4455,7 @@ Also, delete any process that is exited or signaled."
((thread-name (process-thread p)))
(t "--")))
(cmd
- (if (memq type '(network serial))
+ (if (memq type '(network serial pipe))
(let ((contact (process-contact p t t)))
(if (eq type 'network)
(format "(%s %s)"
@@ -4847,11 +5087,20 @@ visual feedback indicating the extent of the region being copied."
(if (called-interactively-p 'interactive)
(indicate-copied-region)))
+(defcustom copy-region-blink-delay 1
+ "Time in seconds to delay after showing the other end of the region.
+It's used by the command `kill-ring-save' and the function
+`indicate-copied-region' to blink the cursor between point and mark.
+The value 0 disables blinking."
+ :type 'number
+ :group 'killing
+ :version "28.1")
+
(defun indicate-copied-region (&optional message-len)
"Indicate that the region text has been copied interactively.
-If the mark is visible in the selected window, blink the cursor
-between point and mark if there is currently no active region
-highlighting.
+If the mark is visible in the selected window, blink the cursor between
+point and mark if there is currently no active region highlighting.
+The option `copy-region-blink-delay' can disable blinking.
If the mark lies outside the selected window, display an
informative message containing a sample of the copied text. The
@@ -4865,12 +5114,14 @@ of this sample text; it defaults to 40."
(if (pos-visible-in-window-p mark (selected-window))
;; Swap point-and-mark quickly so as to show the region that
;; was selected. Don't do it if the region is highlighted.
- (unless (and (region-active-p)
- (face-background 'region nil t))
+ (when (and (numberp copy-region-blink-delay)
+ (> copy-region-blink-delay 0)
+ (or (not (region-active-p))
+ (not (face-background 'region nil t))))
;; Swap point and mark.
(set-marker (mark-marker) (point) (current-buffer))
(goto-char mark)
- (sit-for blink-matching-delay)
+ (sit-for copy-region-blink-delay)
;; Swap back.
(set-marker (mark-marker) mark (current-buffer))
(goto-char point)
@@ -4881,11 +5132,14 @@ of this sample text; it defaults to 40."
(let ((len (min (abs (- mark point))
(or message-len 40))))
(if (< point mark)
- ;; Don't say "killed"; that is misleading.
- (message "Saved text until \"%s\""
- (buffer-substring-no-properties (- mark len) mark))
- (message "Saved text from \"%s\""
- (buffer-substring-no-properties mark (+ mark len))))))))
+ ;; Don't say "killed" or "saved"; that is misleading.
+ (message "Copied text until \"%s\""
+ ;; Don't show newlines literally
+ (query-replace-descr
+ (buffer-substring-no-properties (- mark len) mark)))
+ (message "Copied text from \"%s\""
+ (query-replace-descr
+ (buffer-substring-no-properties mark (+ mark len)))))))))
(defun append-next-kill (&optional interactive)
"Cause following command, if it kills, to add to previous kill.
@@ -5963,8 +6217,6 @@ Does not set point. Does nothing if mark ring is empty."
(pop mark-ring))
(deactivate-mark))
-(define-obsolete-function-alias
- 'exchange-dot-and-mark 'exchange-point-and-mark "23.3")
(defun exchange-point-and-mark (&optional arg)
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active,
@@ -6862,15 +7114,16 @@ rests."
(setq done t)))))))
(defun move-beginning-of-line (arg)
- "Move point to beginning of current line as displayed.
-\(If there's an image in the line, this disregards newlines
-that are part of the text that the image rests on.)
+ "Move point to visible beginning of current logical line.
+This disregards any invisible newline characters.
With argument ARG not nil or 1, move forward ARG - 1 lines first.
If point reaches the beginning or end of buffer, it stops there.
\(But if the buffer doesn't end in a newline, it stops at the
beginning of the last line.)
-To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
+
+To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
+For motion by visual lines, see `beginning-of-visual-line'."
(interactive "^p")
(or arg (setq arg 1))
@@ -7083,15 +7336,16 @@ Mode' for details."
:lighter " Wrap"
(if visual-line-mode
(progn
- (set (make-local-variable 'visual-line--saved-state) nil)
- ;; Save the local values of some variables, to be restored if
- ;; visual-line-mode is turned off.
- (dolist (var '(line-move-visual truncate-lines
- truncate-partial-width-windows
- word-wrap fringe-indicator-alist))
- (if (local-variable-p var)
- (push (cons var (symbol-value var))
- visual-line--saved-state)))
+ (unless visual-line--saved-state
+ (setq-local visual-line--saved-state (list nil))
+ ;; Save the local values of some variables, to be restored if
+ ;; visual-line-mode is turned off.
+ (dolist (var '(line-move-visual truncate-lines
+ truncate-partial-width-windows
+ word-wrap fringe-indicator-alist))
+ (if (local-variable-p var)
+ (push (cons var (symbol-value var))
+ visual-line--saved-state))))
(set (make-local-variable 'line-move-visual) t)
(set (make-local-variable 'truncate-partial-width-windows) nil)
(setq truncate-lines nil
@@ -7105,7 +7359,8 @@ Mode' for details."
(kill-local-variable 'truncate-partial-width-windows)
(kill-local-variable 'fringe-indicator-alist)
(dolist (saved visual-line--saved-state)
- (set (make-local-variable (car saved)) (cdr saved)))
+ (when (car saved)
+ (set (make-local-variable (car saved)) (cdr saved))))
(kill-local-variable 'visual-line--saved-state)))
(defun turn-on-visual-line-mode ()
@@ -7650,11 +7905,17 @@ a specialization of overwrite mode, entered by setting the
Line numbers do not appear for very large buffers and buffers
with very long lines; see variables `line-number-display-limit'
-and `line-number-display-limit-width'."
+and `line-number-display-limit-width'.
+
+See `mode-line-position-line-format' for how this number is
+presented."
:init-value t :global t :group 'mode-line)
(define-minor-mode column-number-mode
- "Toggle column number display in the mode line (Column Number mode)."
+ "Toggle column number display in the mode line (Column Number mode).
+
+See `mode-line-position-column-format' for how this number is
+presented."
:global t :group 'mode-line)
(define-minor-mode size-indication-mode
@@ -7773,6 +8034,7 @@ The function should return non-nil if the two tokens do not match.")
(blinkpos
(save-excursion
(save-restriction
+ (syntax-propertize (point))
(if blink-matching-paren-distance
(narrow-to-region
(max (minibuffer-prompt-end) ;(point-min) unless minibuf.
@@ -7783,7 +8045,6 @@ The function should return non-nil if the two tokens do not match.")
(not blink-matching-paren-dont-ignore-comments))))
(condition-case ()
(progn
- (syntax-propertize (point))
(forward-sexp -1)
;; backward-sexp skips backward over prefix chars,
;; so move back to the matching paren.
@@ -8154,7 +8415,7 @@ makes it easier to edit it."
(interactive
(let* ((default-var (variable-at-point))
(var (if (custom-variable-p default-var)
- (read-variable (format "Set variable (default %s): " default-var)
+ (read-variable (format-prompt "Set variable" default-var)
default-var)
(read-variable "Set variable: ")))
(minibuffer-help-form `(describe-variable ',var))
@@ -8249,18 +8510,6 @@ Called with three arguments (BEG END TEXT), it should replace the text
between BEG and END with TEXT. Expected to be set buffer-locally
in the *Completions* buffer.")
-(defvar completion-base-size nil
- "Number of chars before point not involved in completion.
-This is a local variable in the completion list buffer.
-It refers to the chars in the minibuffer if completing in the
-minibuffer, or in `completion-reference-buffer' otherwise.
-Only characters in the field at point are included.
-
-If nil, Emacs determines which part of the tail end of the
-buffer's text is involved in completion by comparing the text
-directly.")
-(make-obsolete-variable 'completion-base-size 'completion-base-position "23.2")
-
(defun delete-completion-window ()
"Delete the completion list window.
Go to the window from which completion was requested."
@@ -8314,7 +8563,6 @@ If EVENT, use EVENT's position to determine the starting position."
(run-hooks 'mouse-leave-buffer-hook)
(with-current-buffer (window-buffer (posn-window (event-start event)))
(let ((buffer completion-reference-buffer)
- (base-size completion-base-size)
(base-position completion-base-position)
(insert-function completion-list-insert-choice-function)
(choice
@@ -8341,10 +8589,6 @@ If EVENT, use EVENT's position to determine the starting position."
(choose-completion-string
choice buffer
(or base-position
- (when base-size
- ;; Someone's using old completion code that doesn't know
- ;; about base-position yet.
- (list (+ base-size (field-beginning))))
;; If all else fails, just guess.
(list (choose-completion-guess-base-position choice)))
insert-function)))))
@@ -8372,10 +8616,6 @@ If EVENT, use EVENT's position to determine the starting position."
(forward-char 1))
(point))))
-(defun choose-completion-delete-max-match (string)
- (declare (obsolete choose-completion-guess-base-position "23.2"))
- (delete-region (choose-completion-guess-base-position string) (point)))
-
(defvar choose-completion-string-functions nil
"Functions that may override the normal insertion of a completion choice.
These functions are called in order with three arguments:
@@ -8404,13 +8644,6 @@ back on `completion-list-insert-choice-function' when nil."
;; unless it is reading a file name and CHOICE is a directory,
;; or completion-no-auto-exit is non-nil.
- ;; Some older code may call us passing `base-size' instead of
- ;; `base-position'. It's difficult to make any use of `base-size',
- ;; so we just ignore it.
- (unless (consp base-position)
- (message "Obsolete `base-size' passed to choose-completion-string")
- (setq base-position nil))
-
(let* ((buffer (or buffer completion-reference-buffer))
(mini-p (minibufferp buffer)))
;; If BUFFER is a minibuffer, barf unless it's the currently
@@ -8466,8 +8699,7 @@ Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
to select the completion near point.
Or click to select one with the mouse.
-\\{completion-list-mode-map}"
- (set (make-local-variable 'completion-base-size) nil))
+\\{completion-list-mode-map}")
(defun completion-list-mode-finish ()
"Finish setup of the completions buffer.
@@ -8504,14 +8736,11 @@ Called from `temp-buffer-show-hook'."
(if minibuffer-completing-file-name
(file-name-as-directory
(expand-file-name
- (buffer-substring (minibuffer-prompt-end)
- (- (point) (or completion-base-size 0))))))))
+ (buffer-substring (minibuffer-prompt-end) (point)))))))
(with-current-buffer standard-output
- (let ((base-size completion-base-size) ;Read before killing localvars.
- (base-position completion-base-position)
+ (let ((base-position completion-base-position)
(insert-fun completion-list-insert-choice-function))
(completion-list-mode)
- (set (make-local-variable 'completion-base-size) base-size)
(set (make-local-variable 'completion-base-position) base-position)
(set (make-local-variable 'completion-list-insert-choice-function)
insert-fun))
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index 8c694c128b5..6e2c10d9711 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -1,4 +1,4 @@
-;;; skeleton.el --- Lisp language extension for writing statement skeletons
+;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1996, 2001-2020 Free Software Foundation, Inc.
@@ -135,7 +135,8 @@ A prefix argument of -1 says to wrap around region, even if not highlighted.
A prefix argument of zero says to wrap around zero words---that is, nothing.
This is a way of overriding the use of a highlighted region.")
(interactive "*P\nP")
- (skeleton-proxy-new ',skeleton str arg))))
+ (atomic-change-group
+ (skeleton-proxy-new ',skeleton str arg)))))
;;;###autoload
(defun skeleton-proxy-new (skeleton &optional str arg)
@@ -154,8 +155,7 @@ of `str' whereas the skeleton's interactor is then ignored."
(prefix-numeric-value (or arg
current-prefix-arg))
(and skeleton-autowrap
- (or (eq last-command 'mouse-drag-region)
- (and transient-mark-mode mark-active))
+ (use-region-p)
;; Deactivate the mark, in case one of the
;; elements of the skeleton is sensitive
;; to such situations (e.g. it is itself a
@@ -258,23 +258,25 @@ available:
(goto-char (car skeleton-regions))
(setq skeleton-regions (cdr skeleton-regions)))
(let ((beg (point))
- skeleton-modified skeleton-point resume: help input v1 v2)
- (setq skeleton-positions nil)
- (unwind-protect
- (cl-progv
- (mapcar #'car skeleton-further-elements)
- (mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements)
- (skeleton-internal-list skeleton str))
- (or (eolp) (not skeleton-end-newline) (newline-and-indent))
- (run-hooks 'skeleton-end-hook)
- (sit-for 0)
- (or (not (eq (window-buffer) (current-buffer)))
- (pos-visible-in-window-p beg)
- (progn
- (goto-char beg)
- (recenter 0)))
- (if skeleton-point
- (goto-char skeleton-point))))))
+ skeleton-modified skeleton-point) ;; resume:
+ (with-suppressed-warnings ((lexical help input v1 v2))
+ (dlet (help input v1 v2)
+ (setq skeleton-positions nil)
+ (unwind-protect
+ (cl-progv
+ (mapcar #'car skeleton-further-elements)
+ (mapcar (lambda (x) (eval (cadr x) t)) skeleton-further-elements)
+ (skeleton-internal-list skeleton str))
+ (or (eolp) (not skeleton-end-newline) (newline-and-indent))
+ (run-hooks 'skeleton-end-hook)
+ (sit-for 0)
+ (or (not (eq (window-buffer) (current-buffer)))
+ (pos-visible-in-window-p beg)
+ (progn
+ (goto-char beg)
+ (recenter 0)))
+ (if skeleton-point
+ (goto-char skeleton-point))))))))
(defun skeleton-read (prompt &optional initial-input recursive)
"Function for reading a string from the minibuffer within skeletons.
@@ -327,36 +329,40 @@ automatically, and you are prompted to fill in the variable parts.")))
(signal 'quit t)
prompt))
-(defun skeleton-internal-list (skeleton-il &optional str recursive)
+(defun skeleton-internal-list (skeleton &optional str recursive)
(let* ((start (line-beginning-position))
(column (current-column))
(line (buffer-substring start (line-end-position)))
- opoint)
- (or str
- (setq str `(setq str
- (skeleton-read ',(car skeleton-il) nil ,recursive))))
- (when (and (eq (cadr skeleton-il) '\n) (not recursive)
- (save-excursion (skip-chars-backward " \t") (bolp)))
- (setq skeleton-il (cons nil (cons '> (cddr skeleton-il)))))
- (while (setq skeleton-modified (eq opoint (point))
- opoint (point)
- skeleton-il (cdr skeleton-il))
- (condition-case quit
- (skeleton-internal-1 (car skeleton-il) nil recursive)
- (quit
- (if (eq (cdr quit) 'recursive)
- (setq recursive 'quit
- skeleton-il (memq 'resume: skeleton-il))
- ;; Remove the subskeleton as far as it has been shown
- ;; the subskeleton shouldn't have deleted outside current line.
- (end-of-line)
- (delete-region start (point))
- (insert line)
- (move-to-column column)
- (if (cdr quit)
- (setq skeleton-il ()
- recursive nil)
- (signal 'quit 'recursive)))))))
+ (skeleton-il skeleton)
+ opoint)
+ (with-suppressed-warnings ((lexical str))
+ (dlet ((str (or str
+ `(setq str
+ (skeleton-read ',(car skeleton-il)
+ nil ,recursive))))
+ resume:)
+ (when (and (eq (cadr skeleton-il) '\n) (not recursive)
+ (save-excursion (skip-chars-backward " \t") (bolp)))
+ (setq skeleton-il (cons nil (cons '> (cddr skeleton-il)))))
+ (while (setq skeleton-modified (eq opoint (point))
+ opoint (point)
+ skeleton-il (cdr skeleton-il))
+ (condition-case quit
+ (skeleton-internal-1 (car skeleton-il) nil recursive)
+ (quit
+ (if (eq (cdr quit) 'recursive)
+ (setq recursive 'quit
+ skeleton-il (memq 'resume: skeleton-il))
+ ;; Remove the subskeleton as far as it has been shown
+ ;; the subskeleton shouldn't have deleted outside current line.
+ (end-of-line)
+ (delete-region start (point))
+ (insert line)
+ (move-to-column column)
+ (if (cdr quit)
+ (setq skeleton-il ()
+ recursive nil)
+ (signal 'quit 'recursive)))))))))
;; maybe continue loop or go on to next outer resume: section
(if (eq recursive 'quit)
(signal 'quit 'recursive)
diff --git a/lisp/so-long.el b/lisp/so-long.el
index c800c7a1430..6ae8d0aec8a 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -389,7 +389,7 @@
;; this caveat is the `mode' pseudo-variable, which is processed early in all
;; versions of Emacs, and can be set to `so-long-mode' if desired.
-;;; * Change Log:
+;; * Change Log:
;;
;; 1.0 - Included in Emacs 27.1, and in GNU ELPA for prior versions of Emacs.
;; - New global mode `global-so-long-mode' to enable/disable the library.
@@ -833,7 +833,7 @@ available in Emacs versions < 27). For more information refer to info node
`(emacs) Bidirectional Editing' and info node `(elisp) Bidirectional Display'.
Buffers are made read-only by default to prevent potentially-slow editing from
-occurring inadvertantly, as buffers with excessively long lines are likely not
+occurring inadvertently, as buffers with excessively long lines are likely not
intended to be edited manually."
:type '(alist :key-type (variable :tag "Variable")
:value-type (sexp :tag "Value"))
@@ -1001,8 +1001,10 @@ This command calls `so-long' with the selected action as an argument.")
(cl-letf (((symbol-function 'finder-summary) #'ignore))
(finder-commentary "so-long"))
(let ((inhibit-read-only t))
- (when (looking-at "^Commentary:\n\n")
- (replace-match "so-long.el\n\n"))
+ (if (looking-at "^Commentary:\n\n")
+ (replace-match "so-long.el\n\n")
+ (insert "so-long.el\n")
+ (forward-line 1))
(save-excursion
(while (re-search-forward "^-+$" nil :noerror)
(replace-match ""))))
diff --git a/lisp/sort.el b/lisp/sort.el
index f878db24a3c..b9a27a84e44 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -251,7 +251,7 @@ the sort order."
(narrow-to-region beg end)
(goto-char (point-min))
(sort-subr reverse
- (function (lambda () (skip-chars-forward "\n")))
+ (lambda () (skip-chars-forward "\n"))
'forward-page))))
(defvar sort-fields-syntax-table nil)
@@ -316,16 +316,16 @@ FIELD, BEG and END. BEG and END specify region to sort."
;;region to sort."
;; (interactive "p\nr")
;; (sort-fields-1 field beg end
-;; (function (lambda ()
-;; (sort-skip-fields field)
-;; (string-to-number
-;; (buffer-substring
-;; (point)
-;; (save-excursion
-;; (re-search-forward
-;; "[+-]?[0-9]*\\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
-;; (point))))))
-;; nil))
+;; (lambda ()
+;; (sort-skip-fields field)
+;; (string-to-number
+;; (buffer-substring
+;; (point)
+;; (save-excursion
+;; (re-search-forward
+;; "[+-]?[0-9]*\\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
+;; (point)))))
+;; nil))
;;;###autoload
(defun sort-fields (field beg end)
@@ -340,10 +340,10 @@ the sort order."
(let ;; To make `end-of-line' and etc. to ignore fields.
((inhibit-field-text-motion t))
(sort-fields-1 field beg end
- (function (lambda ()
- (sort-skip-fields field)
- nil))
- (function (lambda () (skip-chars-forward "^ \t\n"))))))
+ (lambda ()
+ (sort-skip-fields field)
+ nil)
+ (lambda () (skip-chars-forward "^ \t\n")))))
(defun sort-fields-1 (field beg end startkeyfun endkeyfun)
(let ((tbl (syntax-table)))
@@ -457,21 +457,21 @@ sRegexp specifying key within record: \nr")
(goto-char (match-beginning 0))
(sort-subr reverse
'sort-regexp-fields-next-record
- (function (lambda ()
- (goto-char sort-regexp-record-end)))
- (function (lambda ()
- (let ((n 0))
- (cond ((numberp key-regexp)
- (setq n key-regexp))
- ((re-search-forward
- key-regexp sort-regexp-record-end t)
- (setq n 0))
- (t (throw 'key nil)))
- (condition-case ()
- (cons (match-beginning n)
- (match-end n))
- ;; if there was no such register
- (error (throw 'key nil)))))))))))
+ (lambda ()
+ (goto-char sort-regexp-record-end))
+ (lambda ()
+ (let ((n 0))
+ (cond ((numberp key-regexp)
+ (setq n key-regexp))
+ ((re-search-forward
+ key-regexp sort-regexp-record-end t)
+ (setq n 0))
+ (t (throw 'key nil)))
+ (condition-case ()
+ (cons (match-beginning n)
+ (match-end n))
+ ;; if there was no such register
+ (error (throw 'key nil))))))))))
(defvar sort-columns-subprocess t)
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 4cd4fb9161d..3619b23d9e6 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -7,10 +7,12 @@
(defvar speedbar-version "1.0"
"The current version of speedbar.")
+(make-obsolete-variable 'speedbar-version nil "28.1")
(defvar speedbar-incompatible-version "0.14beta4"
"This version of speedbar is incompatible with this version.
Due to massive API changes (removing the use of the word PATH)
this version is not backward compatible to 0.14 or earlier.")
+(make-obsolete-variable 'speedbar-incompatible-version nil "28.1")
;; This file is part of GNU Emacs.
@@ -115,7 +117,7 @@ this version is not backward compatible to 0.14 or earlier.")
(require 'easymenu)
(require 'dframe)
-(require 'sb-image)
+(require 'ezimage)
;; customization stuff
(defgroup speedbar nil
@@ -141,6 +143,12 @@ this version is not backward compatible to 0.14 or earlier.")
:prefix "speedbar-"
:group 'speedbar)
+(defcustom speedbar-use-images ezimage-use-images
+ "Non-nil if speedbar should display icons."
+ :group 'speedbar
+ :version "21.1"
+ :type 'boolean)
+
;;; Code:
;; Note: `inversion-test' requires parts of the CEDET package that are
@@ -296,6 +304,8 @@ The default buffer is the buffer in the selected window in the attached frame."
"Hooks run when speedbar is loaded."
:group 'speedbar
:type 'hook)
+(make-obsolete-variable 'speedbar-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom speedbar-reconfigure-keymaps-hook nil
"Hooks run when the keymaps are regenerated."
@@ -641,7 +651,7 @@ They should include commonly existing directories which are not
useful. It is no longer necessary to include version-control
directories here; see `vc-directory-exclusion-list'."
:group 'speedbar
- :type 'string)
+ :type 'regexp)
(defcustom speedbar-file-unshown-regexp
(let ((nstr "") (noext completion-ignored-extensions))
@@ -654,7 +664,7 @@ directories here; see `vc-directory-exclusion-list'."
"Regexp matching files we don't want displayed in a speedbar buffer.
It is generated from the variable `completion-ignored-extensions'."
:group 'speedbar
- :type 'string)
+ :type 'regexp)
(defvar speedbar-file-regexp nil
"Regular expression matching files we know how to expand.
@@ -889,12 +899,9 @@ This basically creates a sparse keymap, and makes its parent be
"Additional menu items while in file-mode.")
(defvar speedbar-easymenu-definition-trailer
- (append
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- (list ["Customize..." speedbar-customize t]))
- (list
+ '(["Customize..." speedbar-customize t]
["Close" dframe-close-frame t]
- ["Quit" delete-frame t] ))
+ ["Quit" delete-frame t])
"Menu items appearing at the end of the speedbar menu.")
(defvar speedbar-desired-buffer nil
@@ -1069,7 +1076,7 @@ in the selected file.
(setq font-lock-keywords nil) ;; no font-locking please
(setq truncate-lines t)
(make-local-variable 'frame-title-format)
- (setq frame-title-format (concat "Speedbar " speedbar-version)
+ (setq frame-title-format "Speedbar"
case-fold-search nil
buffer-read-only t)
(speedbar-set-mode-line-format)
@@ -1382,7 +1389,7 @@ Argument ARG represents to force a refresh past any caches that may exist."
(if (and (file-exists-p f) (string-match "\\.el\\'" f))
(progn
(dframe-select-attached-frame speedbar-frame)
- (byte-compile-file f nil)
+ (byte-compile-file f)
(select-frame sf)
(speedbar-reset-scanners)))
))
@@ -1703,7 +1710,7 @@ argument."
(put-text-property start end 'help-echo #'dframe-help-echo))
(if function (put-text-property start end 'speedbar-function function))
(if token (put-text-property start end 'speedbar-token token))
- ;; So far the only text we have is less that 3 chars.
+ ;; So far the only text we have is less than 3 chars.
(if (<= (- end start) 3)
(speedbar-insert-image-button-maybe start (- end start)))
)
@@ -1749,8 +1756,9 @@ This is based on `speedbar-initial-expansion-list-name' referencing
"Change speedbar's default expansion list to NEW-DEFAULT."
(interactive
(list
- (completing-read (format "Speedbar Mode (default %s): "
- speedbar-previously-used-expansion-list-name)
+ (completing-read (format-prompt
+ "Speedbar Mode"
+ speedbar-previously-used-expansion-list-name)
speedbar-initial-expansion-mode-alist
nil t "" nil
speedbar-previously-used-expansion-list-name)))
@@ -1866,9 +1874,9 @@ matches the user directory ~, then it is replaced with a ~.
INDEX is not used, but is required by the caller."
(let* ((tilde (expand-file-name "~/"))
(dd (expand-file-name directory))
- (junk (string-match (regexp-quote tilde) dd))
+ (junk (string-prefix-p "~/" dd))
(displayme (if junk
- (concat "~/" (substring dd (match-end 0)))
+ (concat "~/" (substring dd 2 nil))
dd))
(p (point)))
(if (string-match "^~[/\\]?\\'" displayme) (setq displayme tilde))
@@ -3230,19 +3238,21 @@ With universal argument ARG, flush cached data."
"Expand the line under the cursor and all descendants.
Optional argument ARG indicates that any cache should be flushed."
(interactive "P")
- (speedbar-expand-line arg)
- ;; Now, inside the area expanded here, expand all subnodes of
- ;; the same descendant type.
- (save-excursion
- (speedbar-next 1) ;; Move into the list.
- (let ((err nil))
- (while (not err)
- (condition-case nil
- (progn
- (speedbar-expand-line-descendants arg)
- (speedbar-restricted-next 1))
- (error (setq err t))))))
- )
+ (save-restriction
+ (narrow-to-region (line-beginning-position)
+ (line-beginning-position 2))
+ (speedbar-expand-line arg)
+ ;; Now, inside the area expanded here, expand all subnodes of
+ ;; the same descendant type.
+ (save-excursion
+ (speedbar-next 1) ;; Move into the list.
+ (let ((err nil))
+ (while (not err)
+ (condition-case nil
+ (progn
+ (speedbar-expand-line-descendants arg)
+ (speedbar-restricted-next 1))
+ (error (setq err t))))))))
(defun speedbar-contract-line-descendants ()
"Expand the line under the cursor and all descendants."
@@ -4022,6 +4032,68 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
(setq font-lock-global-modes (delq 'speedbar-mode
font-lock-global-modes)))))
+;;; Image management
+
+(defvar speedbar-expand-image-button-alist
+ '(("<+>" . ezimage-directory-plus)
+ ("<->" . ezimage-directory-minus)
+ ("< >" . ezimage-directory)
+ ("[+]" . ezimage-page-plus)
+ ("[-]" . ezimage-page-minus)
+ ("[?]" . ezimage-page)
+ ("[ ]" . ezimage-page)
+ ("{+}" . ezimage-box-plus)
+ ("{-}" . ezimage-box-minus)
+ ("<M>" . ezimage-mail)
+ ("<d>" . ezimage-document-tag)
+ ("<i>" . ezimage-info-tag)
+ (" =>" . ezimage-tag)
+ (" +>" . ezimage-tag-gt)
+ (" ->" . ezimage-tag-v)
+ (">" . ezimage-tag)
+ ("@" . ezimage-tag-type)
+ (" @" . ezimage-tag-type)
+ ("*" . ezimage-checkout)
+ ("#" . ezimage-object)
+ ("!" . ezimage-object-out-of-date)
+ ("//" . ezimage-label)
+ ("%" . ezimage-lock)
+ )
+ "List of text and image associations.")
+
+(defun speedbar-insert-image-button-maybe (start length)
+ "Insert an image button based on text starting at START for LENGTH chars.
+If buttontext is unknown, just insert that text.
+If we have an image associated with it, use that image."
+ (when speedbar-use-images
+ (let ((ezimage-expand-image-button-alist
+ speedbar-expand-image-button-alist))
+ (ezimage-insert-image-button-maybe start length))))
+
+(defun speedbar-image-dump ()
+ "Dump out the current state of the Speedbar image alist.
+See `speedbar-expand-image-button-alist' for details."
+ (interactive)
+ (with-output-to-temp-buffer "*Speedbar Images*"
+ (with-current-buffer "*Speedbar Images*"
+ (goto-char (point-max))
+ (insert "Speedbar image cache.\n\n")
+ (let ((start (point)) (end nil))
+ (insert "Image\tText\tImage Name")
+ (setq end (point))
+ (insert "\n")
+ (put-text-property start end 'face 'underline))
+ (let ((ia speedbar-expand-image-button-alist))
+ (while ia
+ (let ((start (point)))
+ (insert (car (car ia)))
+ (insert "\t")
+ (speedbar-insert-image-button-maybe start
+ (length (car (car ia))))
+ (insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n"))
+ (setq ia (cdr ia)))))))
+
+
(provide 'speedbar)
;; run load-time hooks
diff --git a/lisp/startup.el b/lisp/startup.el
index c8b36e205fd..9f67dfde124 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -463,9 +463,6 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(and (string-match "\\`[[:alnum:]]" file)
;; The lower-case variants of RCS and CVS are for DOS/Windows.
(not (member file '("RCS" "CVS" "rcs" "cvs")))
- ;; Avoid doing a `stat' when it isn't necessary because
- ;; that can cause trouble when an NFS server is down.
- (not (string-match "\\.elc?\\'" file))
(file-directory-p file)
(let ((expanded (expand-file-name file)))
(or (file-exists-p (expand-file-name ".nosearch" expanded))
@@ -645,16 +642,13 @@ It is the default value of the variable `top-level'."
(list (default-value 'user-full-name)))
;; If the PWD environment variable isn't accurate, delete it.
(let ((pwd (getenv "PWD")))
- (and (stringp pwd)
- ;; Use FOO/., so that if FOO is a symlink, file-attributes
- ;; describes the directory linked to, not FOO itself.
+ (and pwd
(or (and default-directory
(ignore-errors
(equal (file-attributes
- (concat (file-name-as-directory pwd) "."))
+ (file-name-as-directory pwd))
(file-attributes
- (concat (file-name-as-directory default-directory)
- ".")))))
+ (file-name-as-directory default-directory)))))
(setq process-environment
(delete (concat "PWD=" pwd)
process-environment)))))
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 334e1a72d38..11bc07a29cc 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -296,6 +296,8 @@ the corresponding interactive function.")
(defvar strokes-load-hook nil
"Functions to be called when Strokes is loaded.")
+(make-obsolete-variable 'strokes-load-hook
+ "use `with-eval-after-load' instead." "28.1")
;;; ### NOT IMPLEMENTED YET ###
;;(defvar edit-strokes-menu
@@ -572,9 +574,8 @@ Optional GRID-RESOLUTION may be used in place of `strokes-grid-resolution'.
The grid is a square whose dimension is [0,GRID-RESOLUTION)."
(or grid-resolution (setq grid-resolution strokes-grid-resolution))
(let ((stroke-extent (strokes-get-stroke-extent positions)))
- (mapcar (function
- (lambda (pos)
- (strokes-get-grid-position stroke-extent pos grid-resolution)))
+ (mapcar (lambda (pos)
+ (strokes-get-grid-position stroke-extent pos grid-resolution))
positions)))
(defun strokes-fill-stroke (unfilled-stroke &optional force)
@@ -1373,9 +1374,7 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead."
(defun strokes-alphabetic-lessp (stroke1 stroke2)
"Return t if STROKE1's command name precedes STROKE2's in lexicographic order."
- (let ((command-name-1 (symbol-name (cdr stroke1)))
- (command-name-2 (symbol-name (cdr stroke2))))
- (string-lessp command-name-1 command-name-2)))
+ (string-lessp (cdr stroke1) (cdr stroke2)))
(defvar strokes-mode-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/subr.el b/lisp/subr.el
index fcbd06a449f..6e9f66fe97b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -193,9 +193,9 @@ except that PLACE is evaluated only once (after NEWELT)."
(list 'setq place
(list 'cons newelt place))
(require 'macroexp)
- (macroexp-let2 macroexp-copyable-p v newelt
+ (macroexp-let2 macroexp-copyable-p x newelt
(gv-letplace (getter setter) place
- (funcall setter `(cons ,v ,getter))))))
+ (funcall setter `(cons ,x ,getter))))))
(defmacro pop (place)
"Return the first element of PLACE's value, and remove it from the list.
@@ -257,10 +257,9 @@ Then evaluate RESULT to get return value, default nil.
;; use dolist.
;; FIXME: This cost disappears in byte-compiled lexical-binding files.
(let ((temp '--dolist-tail--))
- ;; This is not a reliable test, but it does not matter because both
- ;; semantics are acceptable, tho one is slightly faster with dynamic
- ;; scoping and the other is slightly faster (and has cleaner semantics)
- ;; with lexical scoping.
+ ;; This test does not matter much because both semantics are acceptable,
+ ;; but one is slightly faster with dynamic scoping and the other is
+ ;; slightly faster (and has cleaner semantics) with lexical scoping.
(if lexical-binding
`(let ((,temp ,(nth 1 spec)))
(while ,temp
@@ -280,8 +279,11 @@ Then evaluate RESULT to get return value, default nil.
(defmacro dotimes (spec &rest body)
"Loop a certain number of times.
Evaluate BODY with VAR bound to successive integers running from 0,
-inclusive, to COUNT, exclusive. Then evaluate RESULT to get
-the return value (nil if RESULT is omitted). Its use is deprecated.
+inclusive, to COUNT, exclusive.
+
+Finally RESULT is evaluated to get the return value (nil if
+RESULT is omitted). Using RESULT is deprecated, and may result
+in compilation warnings about unused variables.
\(fn (VAR COUNT [RESULT]) BODY...)"
(declare (indent 1) (debug dolist))
@@ -292,9 +294,9 @@ the return value (nil if RESULT is omitted). Its use is deprecated.
(let ((temp '--dotimes-limit--)
(start 0)
(end (nth 1 spec)))
- ;; This is not a reliable test, but it does not matter because both
- ;; semantics are acceptable, tho one is slightly faster with dynamic
- ;; scoping and the other has cleaner semantics.
+ ;; This test does not matter much because both semantics are acceptable,
+ ;; but one is slightly faster with dynamic scoping and the other has
+ ;; cleaner semantics.
(if lexical-binding
(let ((counter '--dotimes-counter--))
`(let ((,temp ,end)
@@ -767,7 +769,6 @@ If that is non-nil, the element matches; then `assoc-default'
If no element matches, the value is nil.
If TEST is omitted or nil, `equal' is used."
- (declare (side-effect-free t))
(let (found (tail alist) value)
(while (and tail (not found))
(let ((elt (car tail)))
@@ -831,10 +832,11 @@ Elements of ALIST that are not conses are ignored."
If KEY is not found in ALIST, return DEFAULT.
Equality with KEY is tested by TESTFN, defaulting to `eq'.
-You can use `alist-get' in PLACE expressions. This will modify
-an existing association (more precisely, the first one if
-multiple exist), or add a new element to the beginning of ALIST,
-destructively modifying the list stored in ALIST.
+You can use `alist-get' in \"place expressions\"; i.e., as a
+generalized variable. Doing this will modify an existing
+association (more precisely, the first one if multiple exist), or
+add a new element to the beginning of ALIST, destructively
+modifying the list stored in ALIST.
Example:
@@ -894,8 +896,9 @@ This is the same format used for saving keyboard macros (see
For an approximate inverse of this, see `key-description'."
;; Don't use a defalias, since the `pure' property is true only for
;; the calling convention of `kbd'.
- (read-kbd-macro keys))
-(put 'kbd 'pure t)
+ (declare (pure t) (side-effect-free t))
+ ;; A pure function is expected to preserve the match data.
+ (save-match-data (read-kbd-macro keys)))
(defun undefined ()
"Beep to tell the user this binding is undefined."
@@ -1275,10 +1278,10 @@ The normal global definition of the character C-x indirects to this keymap.")
"Convert a key sequence to a list of events."
(if (vectorp key)
(append key nil)
- (mapcar (function (lambda (c)
- (if (> c 127)
- (logxor c listify-key-sequence-1)
- c)))
+ (mapcar (lambda (c)
+ (if (> c 127)
+ (logxor c listify-key-sequence-1)
+ c))
key)))
(defun eventp (object)
@@ -1360,7 +1363,8 @@ EVENT is nil, the value of `posn-at-point' is used instead.
The following accessor functions are used to access the elements
of the position:
-`posn-window': The window the event is in.
+`posn-window': The window of the event end, or its frame if the
+event end point belongs to no window.
`posn-area': A symbol identifying the area the event occurred in,
or nil if the event occurred in the text area.
`posn-point': The buffer position of the event.
@@ -1416,8 +1420,9 @@ than a window, return nil."
(defsubst posn-window (position)
"Return the window in POSITION.
-POSITION should be a list of the form returned by the `event-start'
-and `event-end' functions."
+If POSITION is outside the frame where the event was initiated,
+return that frame instead. POSITION should be a list of the form
+returned by the `event-start' and `event-end' functions."
(nth 0 position))
(defsubst posn-area (position)
@@ -1444,9 +1449,14 @@ a click on a scroll bar)."
(defun posn-set-point (position)
"Move point to POSITION.
Select the corresponding window as well."
- (if (not (windowp (posn-window position)))
+ (if (framep (posn-window position))
+ (progn
+ (unless (windowp (frame-selected-window (posn-window position)))
+ (error "Position not in text area of window"))
+ (select-window (frame-selected-window (posn-window position))))
+ (unless (windowp (posn-window position))
(error "Position not in text area of window"))
- (select-window (posn-window position))
+ (select-window (posn-window position)))
(if (numberp (posn-point position))
(goto-char (posn-point position))))
@@ -1558,7 +1568,6 @@ be a list of the form returned by `event-start' and `event-end'."
;;;; Obsolescent names for functions.
-(make-obsolete 'forward-point "use (+ (point) N) instead." "23.1")
(make-obsolete 'buffer-has-markers-at nil "24.3")
(make-obsolete 'invocation-directory "use the variable of the same name."
@@ -1604,8 +1613,6 @@ be a list of the form returned by `event-start' and `event-end'."
(make-obsolete 'set-window-redisplay-end-trigger nil "23.1")
(make-obsolete 'run-window-configuration-change-hook nil "27.1")
-(make-obsolete 'process-filter-multibyte-p nil "23.1")
-(make-obsolete 'set-process-filter-multibyte nil "23.1")
(make-obsolete-variable 'command-debug-status
"expect it to be removed in a future version." "25.2")
@@ -1619,8 +1626,11 @@ be a list of the form returned by `event-start' and `event-end'."
(make-obsolete-variable 'x-gtk-use-window-move nil "26.1")
(defvaralias 'messages-buffer-max-lines 'message-log-max)
-(define-obsolete-variable-alias 'inhibit-null-byte-detection
- 'inhibit-nul-byte-detection "27.1")
+(define-obsolete-variable-alias 'inhibit-nul-byte-detection
+ 'inhibit-null-byte-detection "28.1")
+(make-obsolete-variable 'load-dangerous-libraries
+ "no longer used." "27.1")
+
;;;; Alternate names for functions - these are not being phased out.
@@ -1645,7 +1655,8 @@ be a list of the form returned by `event-start' and `event-end'."
(defalias 'point-at-eol 'line-end-position)
(defalias 'point-at-bol 'line-beginning-position)
-(defalias 'user-original-login-name 'user-login-name)
+(define-obsolete-function-alias 'user-original-login-name
+ 'user-login-name "28.1")
;;;; Hook manipulation functions.
@@ -1774,6 +1785,21 @@ all symbols are bound before any of the VALUEFORMs are evalled."
,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
,@body))
+(defmacro dlet (binders &rest body)
+ "Like `let*' but using dynamic scoping."
+ (declare (indent 1) (debug let))
+ ;; (defvar FOO) only affects the current scope, but in order for
+ ;; this not to affect code after the `let*' we need to create a new scope,
+ ;; which is what the surrounding `let' is for.
+ ;; FIXME: (let () ...) currently doesn't actually create a new scope,
+ ;; which is why we use (let (_) ...).
+ `(let (_)
+ ,@(mapcar (lambda (binder)
+ `(defvar ,(if (consp binder) (car binder) binder)))
+ binders)
+ (let* ,binders ,@body)))
+
+
(defmacro with-wrapper-hook (hook args &rest body)
"Run BODY, using wrapper functions from HOOK with additional ARGS.
HOOK is an abnormal hook. Each hook function in HOOK \"wraps\"
@@ -1804,6 +1830,7 @@ FUN is then called once."
(defmacro subr--with-wrapper-hook-no-warnings (hook args &rest body)
"Like (with-wrapper-hook HOOK ARGS BODY), but without warnings."
+ (declare (debug (form sexp body)))
;; We need those two gensyms because CL's lexical scoping is not available
;; for function arguments :-(
(let ((funs (make-symbol "funs"))
@@ -2263,6 +2290,8 @@ Otherwise TYPE is assumed to be a symbol property."
(not (eq 'require (car match)))))))
(throw 'found file))))))
+(declare-function read-library-name "find-func" nil)
+
(defun locate-library (library &optional nosuffix path interactive-call)
"Show the precise file name of Emacs library LIBRARY.
LIBRARY should be a relative file name of the library, a string.
@@ -2279,12 +2308,7 @@ is used instead of `load-path'.
When called from a program, the file name is normally returned as a
string. When run interactively, the argument INTERACTIVE-CALL is t,
and the file name is displayed in the echo area."
- (interactive (list (completing-read "Locate library: "
- (apply-partially
- 'locate-file-completion-table
- load-path (get-load-suffixes)))
- nil nil
- t))
+ (interactive (list (read-library-name) nil nil t))
(let ((file (locate-file library
(or path load-path)
(append (unless nosuffix (get-load-suffixes))
@@ -2327,13 +2351,19 @@ use `start-file-process'."
(if program
(list :command (cons program program-args))))))
-(defun process-lines (program &rest args)
+(defun process-lines-handling-status (program status-handler &rest args)
"Execute PROGRAM with ARGS, returning its output as a list of lines.
-Signal an error if the program returns with a non-zero exit status."
+If STATUS-HANDLER is non-NIL, it must be a function with one
+argument, which will be called with the exit status of the
+program before the output is collected. If STATUS-HANDLER is
+NIL, an error is signalled if the program returns with a non-zero
+exit status."
(with-temp-buffer
(let ((status (apply 'call-process program nil (current-buffer) nil args)))
- (unless (eq status 0)
- (error "%s exited with status %s" program status))
+ (if status-handler
+ (funcall status-handler status)
+ (unless (eq status 0)
+ (error "%s exited with status %s" program status)))
(goto-char (point-min))
(let (lines)
(while (not (eobp))
@@ -2344,6 +2374,18 @@ Signal an error if the program returns with a non-zero exit status."
(forward-line 1))
(nreverse lines)))))
+(defun process-lines (program &rest args)
+ "Execute PROGRAM with ARGS, returning its output as a list of lines.
+Signal an error if the program returns with a non-zero exit status.
+Also see `process-lines-ignore-status'."
+ (apply #'process-lines-handling-status program nil args))
+
+(defun process-lines-ignore-status (program &rest args)
+ "Execute PROGRAM with ARGS, returning its output as a list of lines.
+The exit status of the program is ignored.
+Also see `process-lines'."
+ (apply #'process-lines-handling-status program #'identity args))
+
(defun process-live-p (process)
"Return non-nil if PROCESS is alive.
A process is considered alive if its status is `run', `open',
@@ -2521,10 +2563,15 @@ by doing (clear-string STRING)."
;; And of course, don't keep the sensitive data around.
(erase-buffer))))))))
-(defun read-number (prompt &optional default)
+(defvar read-number-history nil
+ "The default history for the `read-number' function.")
+
+(defun read-number (prompt &optional default hist)
"Read a numeric value in the minibuffer, prompting with PROMPT.
DEFAULT specifies a default value to return if the user just types RET.
The value of DEFAULT is inserted into PROMPT.
+HIST specifies a history list variable. See `read-from-minibuffer'
+for details of the HIST argument.
This function is used by the `interactive' code letter `n'."
(let ((n nil)
(default1 (if (consp default) (car default) default)))
@@ -2538,7 +2585,7 @@ This function is used by the `interactive' code letter `n'."
(while
(progn
(let ((str (read-from-minibuffer
- prompt nil nil nil nil
+ prompt nil nil nil (or hist 'read-number-history)
(when default
(if (consp default)
(mapcar 'number-to-string (delq nil default))
@@ -2688,7 +2735,7 @@ floating point support."
"Keymap for the `read-char-from-minibuffer' function.")
(defconst read-char-from-minibuffer-map-hash
- (make-hash-table :weakness 'key :test 'equal))
+ (make-hash-table :test 'equal))
(defun read-char-from-minibuffer-insert-char ()
"Insert the character you type in the minibuffer and exit.
@@ -2719,20 +2766,34 @@ the function will ignore any input that is not one of CHARS.
Optional argument HISTORY, if non-nil, should be a symbol that
specifies the history list variable to use for navigating in input
history using `M-p' and `M-n', with `RET' to select a character from
-history."
+history.
+If the caller has set `help-form', there is no need to explicitly add
+`help-char' to chars. It's bound automatically to `help-form-show'."
(let* ((empty-history '())
(map (if (consp chars)
- (or (gethash chars read-char-from-minibuffer-map-hash)
- (puthash chars
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map read-char-from-minibuffer-map)
- (dolist (char chars)
- (define-key map (vector char)
- 'read-char-from-minibuffer-insert-char))
- (define-key map [remap self-insert-command]
- 'read-char-from-minibuffer-insert-other)
- map)
- read-char-from-minibuffer-map-hash))
+ (or (gethash (list help-form (cons help-char chars))
+ read-char-from-minibuffer-map-hash)
+ (let ((map (make-sparse-keymap))
+ (msg help-form))
+ (set-keymap-parent map read-char-from-minibuffer-map)
+ ;; If we have a dynamically bound `help-form'
+ ;; here, then the `C-h' (i.e., `help-char')
+ ;; character should output that instead of
+ ;; being a command char.
+ (when help-form
+ (define-key map (vector help-char)
+ (lambda ()
+ (interactive)
+ (let ((help-form msg)) ; lexically bound msg
+ (help-form-show)))))
+ (dolist (char chars)
+ (define-key map (vector char)
+ 'read-char-from-minibuffer-insert-char))
+ (define-key map [remap self-insert-command]
+ 'read-char-from-minibuffer-insert-other)
+ (puthash (list help-form (cons help-char chars))
+ map read-char-from-minibuffer-map-hash)
+ map))
read-char-from-minibuffer-map))
(result
(read-from-minibuffer prompt nil map nil
@@ -3051,9 +3112,17 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
o1))
(defun remove-overlays (&optional beg end name val)
- "Clear BEG and END of overlays whose property NAME has value VAL.
-Overlays might be moved and/or split.
-BEG and END default respectively to the beginning and end of buffer."
+ "Remove overlays between BEG and END that have property NAME with value VAL.
+Overlays might be moved and/or split. If any targeted overlays
+start before BEG, the overlays will be altered so that they end
+at BEG. Likewise, if the targeted overlays end after END, they
+will be altered so that they start at END. Overlays that start
+at or after BEG and end before END will be removed completely.
+
+BEG and END default respectively to the beginning and end of the
+buffer.
+Values are compared with `eq'.
+If either NAME or VAL are specified, both should be specified."
;; This speeds up the loops over overlays.
(unless beg (setq beg (point-min)))
(unless end (setq end (point-max)))
@@ -3202,7 +3271,7 @@ See Info node `(elisp)Security Considerations'."
;; First, quote argument so that CommandLineToArgvW will
;; understand it. See
- ;; http://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx
+ ;; https://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx
;; After we perform that level of quoting, escape shell
;; metacharacters so that cmd won't mangle our argument. If the
;; argument contains no double quote characters, we can just
@@ -3969,7 +4038,7 @@ the function `undo--wrap-and-run-primitive-undo'."
(let (;; (inhibit-modification-hooks t)
(before-change-functions
;; Ugly Hack: if the body uses syntax-ppss/syntax-propertize
- ;; (e.g. via a regexp-search or sexp-movement trigerring
+ ;; (e.g. via a regexp-search or sexp-movement triggering
;; on-the-fly syntax-propertize), make sure that this gets
;; properly refreshed after subsequent changes.
(if (memq #'syntax-ppss-flush-cache before-change-functions)
@@ -4011,7 +4080,7 @@ the function `undo--wrap-and-run-primitive-undo'."
(defmacro combine-change-calls (beg end &rest body)
"Evaluate BODY, running the change hooks just once.
-BODY is a sequence of lisp forms to evaluate. BEG and END bound
+BODY is a sequence of Lisp forms to evaluate. BEG and END bound
the region the change hooks will be run for.
Firstly, `before-change-functions' is invoked for the region
@@ -4029,7 +4098,8 @@ change `before-change-functions' or `after-change-functions'.
Additionally, the buffer modifications of BODY are recorded on
the buffer's undo list as a single \(apply ...) entry containing
-the function `undo--wrap-and-run-primitive-undo'. "
+the function `undo--wrap-and-run-primitive-undo'."
+ (declare (debug t) (indent 2))
`(combine-change-calls-1 ,beg ,end (lambda () ,@body)))
(defun undo--wrap-and-run-primitive-undo (beg end list)
@@ -4082,8 +4152,6 @@ MODES is as for `set-default-file-modes'."
;;; Matching and match data.
-(defvar save-match-data-internal)
-
;; We use save-match-data-internal as the local variable because
;; that works ok in practice (people should not use that variable elsewhere).
;; We used to use an uninterned symbol; the compiler handles that properly
@@ -4384,6 +4452,27 @@ Unless optional argument INPLACE is non-nil, return a new string."
(aset newstr i tochar)))
newstr))
+(defun string-replace (fromstring tostring instring)
+ "Replace FROMSTRING with TOSTRING in INSTRING each time it occurs."
+ (declare (pure t) (side-effect-free t))
+ (when (equal fromstring "")
+ (signal 'wrong-length-argument fromstring))
+ (let ((start 0)
+ (result nil)
+ pos)
+ (while (setq pos (string-search fromstring instring start))
+ (unless (= start pos)
+ (push (substring instring start pos) result))
+ (push tostring result)
+ (setq start (+ pos (length fromstring))))
+ (if (null result)
+ ;; No replacements were done, so just return the original string.
+ instring
+ ;; Get any remaining bit.
+ (unless (= start (length instring))
+ (push (substring instring start) result))
+ (apply #'concat (nreverse result)))))
+
(defun replace-regexp-in-string (regexp rep string &optional
fixedcase literal subexp start)
"Replace all matches for REGEXP with REP in STRING.
@@ -4651,13 +4740,6 @@ This function is called directly from the C code."
;; Finally, run any other hook.
(run-hook-with-args 'after-load-functions abs-file))
-(defun eval-next-after-load (file)
- "Read the following input sexp, and run it whenever FILE is loaded.
-This makes or adds to an entry on `after-load-alist'.
-FILE should be the name of a library, with no directory name."
- (declare (obsolete eval-after-load "23.2"))
- (eval-after-load file (read)))
-
(defun display-delayed-warnings ()
"Display delayed warnings from `delayed-warnings-list'.
diff --git a/lisp/svg.el b/lisp/svg.el
index 7aadbc23593..eeb945f53b5 100644
--- a/lisp/svg.el
+++ b/lisp/svg.el
@@ -5,7 +5,7 @@
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Felix E. Klee <felix.klee@inka.de>
;; Keywords: image
-;; Version: 1.0
+;; Version: 1.1
;; Package-Requires: ((emacs "25"))
;; This file is part of GNU Emacs.
diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el
index fc174176cd6..4feab71401e 100644
--- a/lisp/t-mouse.el
+++ b/lisp/t-mouse.el
@@ -1,4 +1,4 @@
-;;; t-mouse.el --- mouse support within the text terminal
+;;; t-mouse.el --- mouse support within the text terminal -*- lexical-binding:t -*-
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -63,8 +63,6 @@
(set-terminal-parameter nil 'gpm-mouse-active nil))
;;;###autoload
-(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1")
-;;;###autoload
(define-minor-mode gpm-mouse-mode
"Toggle mouse support in GNU/Linux consoles (GPM Mouse mode).
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index d97ca37a731..26049552242 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -363,22 +363,18 @@ to `tab-bar-tab-name-truncated'."
:group 'tab-bar
:version "27.1")
-(defvar tab-bar-tab-name-ellipsis nil)
+(defvar tab-bar-tab-name-ellipsis t)
(defun tab-bar-tab-name-truncated ()
"Generate tab name from the buffer of the selected window.
Truncate it to the length specified by `tab-bar-tab-name-truncated-max'.
Append ellipsis `tab-bar-tab-name-ellipsis' in this case."
- (let ((tab-name (buffer-name (window-buffer (minibuffer-selected-window))))
- (ellipsis (cond
- (tab-bar-tab-name-ellipsis)
- ((char-displayable-p ?…) "…")
- ("..."))))
+ (let ((tab-name (buffer-name (window-buffer (minibuffer-selected-window)))))
(if (< (length tab-name) tab-bar-tab-name-truncated-max)
tab-name
(propertize (truncate-string-to-width
tab-name tab-bar-tab-name-truncated-max nil nil
- ellipsis)
+ tab-bar-tab-name-ellipsis)
'help-echo tab-name))))
@@ -665,7 +661,8 @@ to get the name of the last visited tab, the second last, and so on."
(let* ((recent-tabs (mapcar (lambda (tab)
(alist-get 'name tab))
(tab-bar--tabs-recent))))
- (list (completing-read "Switch to tab by name (default recent): "
+ (list (completing-read (format-prompt "Switch to tab by name"
+ (car recent-tabs))
recent-tabs nil nil nil nil recent-tabs))))
(tab-bar-select-tab (1+ (or (tab-bar--tab-index-by-name name) 0))))
@@ -799,11 +796,13 @@ After the tab is created, the hooks in
(run-hook-with-args 'tab-bar-tab-post-open-functions
(nth to-index tabs)))
- (when (and (not tab-bar-mode)
- (or (eq tab-bar-show t)
- (and (natnump tab-bar-show)
- (> (length tabs) tab-bar-show))))
+ (cond
+ ((eq tab-bar-show t)
(tab-bar-mode 1))
+ ((and (natnump tab-bar-show)
+ (> (length (funcall tab-bar-tabs-function)) tab-bar-show)
+ (zerop (frame-parameter nil 'tab-bar-lines)))
+ (set-frame-parameter nil 'tab-bar-lines 1)))
(force-mode-line-update)
(unless tab-bar-mode
@@ -936,10 +935,11 @@ for the last tab on a frame is determined by
tab-bar-closed-tabs)
(set-frame-parameter nil 'tabs (delq close-tab tabs)))
- (when (and tab-bar-mode
- (and (natnump tab-bar-show)
- (<= (length tabs) tab-bar-show)))
- (tab-bar-mode -1))
+ (when (and (not (zerop (frame-parameter nil 'tab-bar-lines)))
+ (natnump tab-bar-show)
+ (<= (length (funcall tab-bar-tabs-function))
+ tab-bar-show))
+ (set-frame-parameter nil 'tab-bar-lines 0))
(force-mode-line-update)
(unless tab-bar-mode
@@ -975,10 +975,11 @@ for the last tab on a frame is determined by
(run-hook-with-args 'tab-bar-tab-pre-close-functions (nth index tabs) nil)))
(set-frame-parameter nil 'tabs (list (nth current-index tabs)))
- (when (and tab-bar-mode
- (and (natnump tab-bar-show)
- (<= 1 tab-bar-show)))
- (tab-bar-mode -1))
+ (when (and (not (zerop (frame-parameter nil 'tab-bar-lines)))
+ (natnump tab-bar-show)
+ (<= (length (funcall tab-bar-tabs-function))
+ tab-bar-show))
+ (set-frame-parameter nil 'tab-bar-lines 0))
(force-mode-line-update)
(unless tab-bar-mode
@@ -1483,8 +1484,7 @@ This is an action function for buffer display, see Info
node `(elisp) Buffer Display Action Functions'. It should be
called only by `display-buffer' or a function directly or
indirectly called by the latter."
- (let* ((tab-name (alist-get 'tab-name alist))
- (reusable-frames (alist-get 'reusable-frames alist))
+ (let* ((reusable-frames (alist-get 'reusable-frames alist))
(reusable-tab (when reusable-frames
(tab-bar-get-buffer-tab buffer reusable-frames))))
(if reusable-tab
@@ -1496,17 +1496,46 @@ indirectly called by the latter."
(tab-bar-select-tab (1+ index)))
(when (get-buffer-window buffer frame)
(select-window (get-buffer-window buffer frame))))
+ (let ((tab-name (alist-get 'tab-name alist)))
+ (when (functionp tab-name)
+ (setq tab-name (funcall tab-name buffer alist)))
+ (if tab-name
+ (let ((tab-index (tab-bar--tab-index-by-name tab-name)))
+ (if tab-index
+ (progn
+ (tab-bar-select-tab (1+ tab-index))
+ (when (get-buffer-window buffer)
+ (select-window (get-buffer-window buffer))))
+ (display-buffer-in-new-tab buffer alist)))
+ (display-buffer-in-new-tab buffer alist))))))
+
+(defun display-buffer-in-new-tab (buffer alist)
+ "Display BUFFER in a new tab.
+ALIST is an association list of action symbols and values. See
+Info node `(elisp) Buffer Display Action Alists' for details of
+such alists.
+
+Like `display-buffer-in-tab', but always creates a new tab unconditionally,
+without checking if a suitable tab already exists.
+
+If ALIST contains a `tab-name' entry, it creates a new tab with that name
+and displays BUFFER in a new tab. The `tab-name' entry can be a function,
+then it is called with two arguments: BUFFER and ALIST, and should return
+the tab name. When a `tab-name' entry is omitted, create a new tab without
+an explicit name.
+
+This is an action function for buffer display, see Info
+node `(elisp) Buffer Display Action Functions'. It should be
+called only by `display-buffer' or a function directly or
+indirectly called by the latter."
+ (let ((tab-bar-new-tab-choice t))
+ (tab-bar-new-tab)
+ (let ((tab-name (alist-get 'tab-name alist)))
(when (functionp tab-name)
(setq tab-name (funcall tab-name buffer alist)))
- (if tab-name
- (let ((tab-index (tab-bar--tab-index-by-name tab-name)))
- (if tab-index
- (tab-bar-select-tab (1+ tab-index))
- (let ((tab-bar-new-tab-choice t))
- (tab-bar-new-tab)
- (tab-bar-rename-tab tab-name))))
- (let ((tab-bar-new-tab-choice t))
- (tab-bar-new-tab))))))
+ (when tab-name
+ (tab-bar-rename-tab tab-name)))
+ (window--display-buffer buffer (selected-window) 'tab alist)))
(defun switch-to-buffer-other-tab (buffer-or-name &optional norecord)
"Switch to buffer BUFFER-OR-NAME in another tab.
@@ -1514,8 +1543,7 @@ Like \\[switch-to-buffer-other-frame] (which see), but creates a new tab."
(interactive
(list (read-buffer-to-switch "Switch to buffer in other tab: ")))
(display-buffer (window-normalize-buffer-to-switch-to buffer-or-name)
- '((display-buffer-in-tab
- display-buffer-same-window)
+ '((display-buffer-in-tab)
(inhibit-same-window . nil))
norecord))
@@ -1534,6 +1562,39 @@ Like \\[find-file-other-frame] (which see), but creates a new tab."
value)
(switch-to-buffer-other-tab value))))
+(defun find-file-read-only-other-tab (filename &optional wildcards)
+ "Edit file FILENAME, in another tab, but don't allow changes.
+Like \\[find-file-other-frame] (which see), but creates a new tab.
+
+Like \\[find-file-other-tab], but marks buffer as read-only.
+Use \\[read-only-mode] to permit editing."
+ (interactive
+ (find-file-read-args "Find file read-only in other tab: "
+ (confirm-nonexistent-file-or-buffer)))
+ (find-file--read-only (lambda (filename wildcards)
+ (window-buffer
+ (find-file-other-tab filename wildcards)))
+ filename wildcards))
+
+(defun other-tab-prefix ()
+ "Display the buffer of the next command in a new tab.
+The next buffer is the buffer displayed by the next command invoked
+immediately after this command (ignoring reading from the minibuffer).
+Creates a new tab before displaying the buffer, or switches to the tab
+that already contains that buffer.
+When `switch-to-buffer-obey-display-actions' is non-nil,
+`switch-to-buffer' commands are also supported."
+ (interactive)
+ (display-buffer-override-next-command
+ (lambda (buffer alist)
+ (cons (progn
+ (display-buffer-in-tab
+ buffer (append alist '((inhibit-same-window . nil))))
+ (selected-window))
+ 'tab))
+ nil "[other-tab]")
+ (message "Display next command buffer in a new tab..."))
+
(define-key tab-prefix-map "2" 'tab-new)
(define-key tab-prefix-map "1" 'tab-close-other)
(define-key tab-prefix-map "0" 'tab-close)
@@ -1544,6 +1605,8 @@ Like \\[find-file-other-frame] (which see), but creates a new tab."
(define-key tab-prefix-map "b" 'switch-to-buffer-other-tab)
(define-key tab-prefix-map "f" 'find-file-other-tab)
(define-key tab-prefix-map "\C-f" 'find-file-other-tab)
+(define-key tab-prefix-map "\C-r" 'find-file-read-only-other-tab)
+(define-key tab-prefix-map "t" 'other-tab-prefix)
(provide 'tab-bar)
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index e8c4dc4d93c..46bf89f14eb 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -240,8 +240,7 @@ to `tab-line-tab-name-truncated-buffer'."
:group 'tab-line
:version "27.1")
-(defvar tab-line-tab-name-ellipsis
- (if (char-displayable-p ?…) "…" "..."))
+(defvar tab-line-tab-name-ellipsis t)
(defun tab-line-tab-name-truncated-buffer (buffer &optional _buffers)
"Generate tab name from BUFFER.
@@ -642,6 +641,16 @@ using the `previous-buffer' command."
(with-selected-window window
(switch-to-buffer buffer))))))
+(defcustom tab-line-switch-cycling nil
+ "Enable cycling tab switch.
+If non-nil, `tab-line-switch-to-prev-tab' in the first tab
+switches to the last tab and `tab-line-switch-to-next-tab' in the
+last tab switches to the first tab. This variable is not consulted
+when `tab-line-tabs-function' is `tab-line-tabs-window-buffers'."
+ :type 'boolean
+ :group 'tab-line
+ :version "28.1")
+
(defun tab-line-switch-to-prev-tab (&optional mouse-event)
"Switch to the previous tab.
Its effect is the same as using the `previous-buffer' command
@@ -652,13 +661,16 @@ Its effect is the same as using the `previous-buffer' command
(switch-to-prev-buffer window)
(with-selected-window (or window (selected-window))
(let* ((tabs (funcall tab-line-tabs-function))
- (tab (nth (1- (seq-position
- tabs (current-buffer)
- (lambda (tab buffer)
- (if (bufferp tab)
- (eq buffer tab)
- (eq buffer (cdr (assq 'buffer tab)))))))
- tabs))
+ (pos (seq-position
+ tabs (current-buffer)
+ (lambda (tab buffer)
+ (if (bufferp tab)
+ (eq buffer tab)
+ (eq buffer (cdr (assq 'buffer tab)))))))
+ (tab (if pos
+ (if (and tab-line-switch-cycling (<= pos 0))
+ (nth (1- (length tabs)) tabs)
+ (nth (1- pos) tabs))))
(buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))))
(when (bufferp buffer)
(switch-to-buffer buffer)))))))
@@ -673,13 +685,16 @@ Its effect is the same as using the `next-buffer' command
(switch-to-next-buffer window)
(with-selected-window (or window (selected-window))
(let* ((tabs (funcall tab-line-tabs-function))
- (tab (nth (1+ (seq-position
- tabs (current-buffer)
- (lambda (tab buffer)
- (if (bufferp tab)
- (eq buffer tab)
- (eq buffer (cdr (assq 'buffer tab)))))))
- tabs))
+ (pos (seq-position
+ tabs (current-buffer)
+ (lambda (tab buffer)
+ (if (bufferp tab)
+ (eq buffer tab)
+ (eq buffer (cdr (assq 'buffer tab)))))))
+ (tab (if pos
+ (if (and tab-line-switch-cycling (<= (length tabs) (1+ pos)))
+ (car tabs)
+ (nth (1+ pos) tabs))))
(buffer (if (bufferp tab) tab (cdr (assq 'buffer tab)))))
(when (bufferp buffer)
(switch-to-buffer buffer)))))))
@@ -764,11 +779,15 @@ from the tab line."
(global-set-key [tab-line mouse-5] 'tab-line-hscroll-right)
(global-set-key [tab-line wheel-up] 'tab-line-hscroll-left)
(global-set-key [tab-line wheel-down] 'tab-line-hscroll-right)
+(global-set-key [tab-line wheel-left] 'tab-line-hscroll-left)
+(global-set-key [tab-line wheel-right] 'tab-line-hscroll-right)
(global-set-key [tab-line S-mouse-4] 'tab-line-switch-to-prev-tab)
(global-set-key [tab-line S-mouse-5] 'tab-line-switch-to-next-tab)
(global-set-key [tab-line S-wheel-up] 'tab-line-switch-to-prev-tab)
(global-set-key [tab-line S-wheel-down] 'tab-line-switch-to-next-tab)
+(global-set-key [tab-line S-wheel-left] 'tab-line-switch-to-prev-tab)
+(global-set-key [tab-line S-wheel-right] 'tab-line-switch-to-next-tab)
(provide 'tab-line)
diff --git a/lisp/talk.el b/lisp/talk.el
index 5541b0a4c69..a18cf263435 100644
--- a/lisp/talk.el
+++ b/lisp/talk.el
@@ -90,7 +90,7 @@ Each element has the form (DISPLAY FRAME BUFFER).")
(let ((frame (nth 1 (car tail)))
(this-buffer (nth 2 (car tail)))
(buffers
- (mapcar (function (lambda (elt) (nth 2 elt)))
+ (mapcar (lambda (elt) (nth 2 elt))
talk-display-alist)))
;; Put this display's own talk buffer
;; at the front of the list.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 97d883eebd9..d460c8a4f73 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -37,13 +37,6 @@
;; This code now understands the extra fields that GNU tar adds to tar files.
-;; This interacts correctly with "uncompress.el" in the Emacs library,
-;; which you get with
-;;
-;; (autoload 'uncompress-while-visiting "uncompress")
-;; (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting)
-;; auto-mode-alist))
-;;
;; Do not attempt to use tar-mode.el with crypt.el, you will lose.
;; *************** TO DO ***************
@@ -480,23 +473,9 @@ checksum before doing the check."
(defun tar-grind-file-mode (mode)
"Construct a `rw-r--r--' string indicating MODE.
-MODE should be an integer which is a file mode value."
- (string
- (if (zerop (logand 256 mode)) ?- ?r)
- (if (zerop (logand 128 mode)) ?- ?w)
- (if (zerop (logand 2048 mode))
- (if (zerop (logand 64 mode)) ?- ?x)
- (if (zerop (logand 64 mode)) ?S ?s))
- (if (zerop (logand 32 mode)) ?- ?r)
- (if (zerop (logand 16 mode)) ?- ?w)
- (if (zerop (logand 1024 mode))
- (if (zerop (logand 8 mode)) ?- ?x)
- (if (zerop (logand 8 mode)) ?S ?s))
- (if (zerop (logand 4 mode)) ?- ?r)
- (if (zerop (logand 2 mode)) ?- ?w)
- (if (zerop (logand 512 mode))
- (if (zerop (logand 1 mode)) ?- ?x)
- (if (zerop (logand 1 mode)) ?T ?t))))
+MODE should be an integer which is a file mode value.
+For instance, if mode is #o700, then it produces `rwx------'."
+ (substring (file-modes-number-to-symbolic mode) 1))
(defun tar-header-block-summarize (tar-hblock &optional mod-p)
"Return a line similar to the output of `tar -vtf'."
@@ -936,6 +915,56 @@ actually appear on disk when you save the tar-file's buffer."
(setq buffer-undo-list nil))))
buffer))
+(defun tar-goto-file (file)
+ "Go to FILE in the current buffer.
+FILE should be a relative file name. If FILE can't be found,
+return nil. Otherwise point is returned."
+ (let ((start (point))
+ found)
+ (goto-char (point-min))
+ (while (and (not found)
+ (not (eobp)))
+ (forward-line 1)
+ (when-let ((descriptor (ignore-errors (tar-get-descriptor))))
+ (when (equal (tar-header-name descriptor) file)
+ (setq found t))))
+ (if (not found)
+ (progn
+ (goto-char start)
+ nil)
+ (point))))
+
+(defun tar-next-file-displayer (file regexp n)
+ "Return a closure to display the next file after FILE that matches REGEXP."
+ (let ((short (replace-regexp-in-string "\\`.*!" "" file))
+ next)
+ ;; The tar buffer chops off leading "./", so do the same
+ ;; here.
+ (setq short (replace-regexp-in-string "\\`\\./" "" file))
+ (tar-goto-file short)
+ (while (and (not next)
+ ;; Stop if we reach the end/start of the buffer.
+ (if (> n 0)
+ (not (eobp))
+ (not (save-excursion
+ (beginning-of-line)
+ (bobp)))))
+ (tar-next-line n)
+ (when-let ((descriptor (ignore-errors (tar-get-descriptor))))
+ (let ((candidate (tar-header-name descriptor))
+ (buffer (current-buffer)))
+ (when (and candidate
+ (string-match-p regexp candidate))
+ (setq next (lambda ()
+ (kill-buffer (current-buffer))
+ (switch-to-buffer buffer)
+ (tar-extract)))))))
+ (unless next
+ ;; If we didn't find a next/prev file, then restore
+ ;; point.
+ (tar-goto-file short))
+ next))
+
(defun tar-extract (&optional other-window-p)
"In Tar mode, extract this entry of the tar file into its own buffer."
(interactive)
@@ -1056,7 +1085,7 @@ extracted file."
(write-region start end to-file nil nil nil t))
(when (and tar-copy-preserve-time
date)
- (set-file-times to-file date)))
+ (set-file-times to-file date 'nofollow)))
(message "Copied tar entry %s to %s" name to-file)))
(defun tar-new-entry (filename &optional index)
diff --git a/lisp/tempo.el b/lisp/tempo.el
index ea072ff9dd7..9ee0eefc4ae 100644
--- a/lisp/tempo.el
+++ b/lisp/tempo.el
@@ -75,7 +75,7 @@
;; ftp.lysator.liu.se in the directory /pub/emacs
;; There is also a WWW page at
-;; http://www.lysator.liu.se/~davidk/elisp/ which has some information
+;; https://www.lysator.liu.se/~davidk/elisp/ which has some information
;;; Known bugs:
@@ -220,7 +220,9 @@ list of elements in the template, TAG is the tag used for completion,
DOCUMENTATION is the documentation string for the insertion command
created, and TAGLIST (a symbol) is the tag list that TAG (if provided)
should be added to. If TAGLIST is nil and TAG is non-nil, TAG is
-added to `tempo-tags'.
+added to `tempo-tags'. If TAG already corresponds to a template in
+the tag list, modify the list so that TAG now corresponds to the newly
+defined template.
The elements in ELEMENTS can be of several types:
@@ -304,8 +306,8 @@ mode, ON-REGION is ignored and assumed true if the region is active."
(goto-char tempo-region-start))
(save-excursion
(tempo-insert-mark (point-marker))
- (mapc (function (lambda (elt)
- (tempo-insert elt on-region)))
+ (mapc (lambda (elt)
+ (tempo-insert elt on-region))
(symbol-value template))
(tempo-insert-mark (point-marker)))
(tempo-forward-mark))
@@ -351,9 +353,8 @@ possible."
((and (consp element)
(eq (car element) 's)) (tempo-insert-named (car (cdr element))))
((and (consp element)
- (eq (car element) 'l)) (mapcar (function
- (lambda (elt)
- (tempo-insert elt on-region)))
+ (eq (car element) 'l)) (mapcar (lambda (elt)
+ (tempo-insert elt on-region))
(cdr element)))
((eq element 'p) (tempo-insert-mark (point-marker)))
((eq element 'r) (if on-region
@@ -447,9 +448,9 @@ never prompted."
"Tries all the user-defined element handlers in `tempo-user-elements'."
;; Sigh... I need (some list)
(catch 'found
- (mapc (function (lambda (handler)
- (let ((result (funcall handler element)))
- (if result (throw 'found result)))))
+ (mapc (lambda (handler)
+ (let ((result (funcall handler element)))
+ (if result (throw 'found result))))
tempo-user-elements)
(throw 'found nil)))
@@ -544,10 +545,9 @@ and insert the results."
(interactive)
(let ((next-mark (catch 'found
(mapc
- (function
- (lambda (mark)
- (if (< (point) mark)
- (throw 'found mark))))
+ (lambda (mark)
+ (if (< (point) mark)
+ (throw 'found mark)))
tempo-marks)
;; return nil if not found
nil)))
@@ -563,11 +563,10 @@ and insert the results."
(let ((prev-mark (catch 'found
(let (last)
(mapc
- (function
- (lambda (mark)
- (if (<= (point) mark)
- (throw 'found last))
- (setq last mark)))
+ (lambda (mark)
+ (if (<= (point) mark)
+ (throw 'found last))
+ (setq last mark))
tempo-marks)
last))))
(if prev-mark
@@ -579,14 +578,20 @@ and insert the results."
(defun tempo-add-tag (tag template &optional tag-list)
"Add a template tag.
Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST,
-or to `tempo-tags' if TAG-LIST is nil."
+or to `tempo-tags' if TAG-LIST is nil. If TAG was already in the list,
+replace its template with TEMPLATE."
(interactive "sTag: \nCTemplate: ")
(if (null tag-list)
(setq tag-list 'tempo-tags))
- (if (not (assoc tag (symbol-value tag-list)))
- (set tag-list (cons (cons tag template) (symbol-value tag-list))))
- (tempo-invalidate-collection))
+ (let ((entry (assoc tag (symbol-value tag-list))))
+ (if entry
+ ;; Tag is already in the list, assign a new template to it.
+ (setcdr entry template)
+ ;; Tag is not present in the list, add it with its template.
+ (set tag-list (cons (cons tag template) (symbol-value tag-list)))))
+ ;; Invalidate globally if we're modifying 'tempo-tags'.
+ (tempo-invalidate-collection (eq tag-list 'tempo-tags)))
;;;
;;; tempo-use-tag-list
@@ -609,10 +614,17 @@ COMPLETION-FUNCTION just sets `tempo-match-finder' locally."
;;;
;;; tempo-invalidate-collection
-(defun tempo-invalidate-collection ()
+(defun tempo-invalidate-collection (&optional global)
"Marks the tag collection as obsolete.
-Whenever it is needed again it will be rebuilt."
- (setq tempo-dirty-collection t))
+Whenever it is needed again it will be rebuilt. If GLOBAL is non-nil,
+mark the tag collection of all buffers as obsolete, not just the
+current one."
+ (if global
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (when (assq 'tempo-dirty-collection (buffer-local-variables))
+ (setq tempo-dirty-collection t))))
+ (setq tempo-dirty-collection t)))
;;;
;;; tempo-build-collection
@@ -625,11 +637,11 @@ If `tempo-dirty-collection' is nil, the old collection is reused."
tempo-collection)
(setq tempo-collection
(apply (function append)
- (mapcar (function (lambda (tag-list)
+ (mapcar (lambda (tag-list)
; If the format for
; tempo-local-tags changes,
; change this
- (eval (car tag-list))))
+ (eval (car tag-list)))
tempo-local-tags))))
(setq tempo-dirty-collection nil)))
diff --git a/lisp/term.el b/lisp/term.el
index 09dfeb61d17..8cbbfff1b63 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -241,9 +241,9 @@
;; printf '\033AnSiTu %s\n' "$USER"
;; printf '\033AnSiTc %s\n' "$PWD"
;;
-;; cd() { command cd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
-;; pushd() { command pushd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
-;; popd() { command popd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
+;; cd() { command cd "$@" && printf '\033AnSiTc %s\n' "$PWD"; }
+;; pushd() { command pushd "$@" && printf '\033AnSiTc %s\n' "$PWD"; }
+;; popd() { command popd "$@" && printf '\033AnSiTc %s\n' "$PWD"; }
;;
;; # Use custom dircolors in term buffers.
;; # eval $(dircolors $HOME/.emacs_dircolors)
@@ -467,6 +467,11 @@ Customize this option to nil if you want the previous behavior."
:type 'boolean
:group 'term)
+(defcustom term-set-terminal-size nil
+ "If non-nil, set the LINES and COLUMNS environment variables."
+ :type 'boolean
+ :version "28.1")
+
(defcustom term-char-mode-point-at-process-mark t
"If non-nil, keep point at the process mark in char mode.
@@ -501,6 +506,14 @@ This variable is buffer-local."
:type 'boolean
:group 'term)
+(defcustom term-scroll-snap-to-bottom t
+ "Control whether to keep the prompt at the bottom of the window.
+If non-nil, when the prompt is visible within the window, then
+scroll so that the prompt is on the bottom on any input or
+output."
+ :version "28.1"
+ :type 'boolean)
+
(defcustom term-scroll-show-maximum-output nil
"Controls how interpreter output causes window to scroll.
If non-nil, then show the maximum output when the window is scrolled.
@@ -541,7 +554,7 @@ See also `term-dynamic-complete'.
This is a good thing to set in mode hooks.")
(defvar term-input-filter
- (function (lambda (str) (not (string-match "\\`\\s *\\'" str))))
+ (lambda (str) (not (string-match "\\`\\s *\\'" str)))
"Predicate for filtering additions to input history.
Only inputs answering true to this function are saved on the input
history list. Default is to save anything that isn't all whitespace.")
@@ -847,6 +860,7 @@ is buffer-local."
(define-key map [prior] 'term-send-prior)
(define-key map [next] 'term-send-next)
(define-key map [xterm-paste] #'term--xterm-paste)
+ (define-key map [?\C-/] #'term-send-C-_)
map)
"Keyboard map for sending characters directly to the inferior process.")
@@ -1269,6 +1283,7 @@ without any interpretation."
(defun term-send-next () (interactive) (term-send-raw-string "\e[6~"))
(defun term-send-del () (interactive) (term-send-raw-string "\e[3~"))
(defun term-send-backspace () (interactive) (term-send-raw-string "\C-?"))
+(defun term-send-C-_ () (interactive) (term-send-raw-string "\C-_"))
(defun term-char-mode ()
"Switch to char (\"raw\") sub-mode of term mode.
@@ -1543,9 +1558,12 @@ Nil if unknown.")
(format term-termcap-format "TERMCAP="
term-term-name term-height term-width)
- (format "INSIDE_EMACS=%s,term:%s" emacs-version term-protocol-version)
- (format "LINES=%d" term-height)
- (format "COLUMNS=%d" term-width))
+ (format "INSIDE_EMACS=%s,term:%s"
+ emacs-version term-protocol-version))
+ (when term-set-terminal-size
+ (list
+ (format "LINES=%d" term-height)
+ (format "COLUMNS=%d" term-width)))
process-environment))
(process-connection-type t)
;; We should suppress conversion of end-of-line format.
@@ -2787,7 +2805,7 @@ See `term-prompt-regexp'."
;; References:
;; [ctlseqs]: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html
-;; [ECMA-48]: http://www.ecma-international.org/publications/standards/Ecma-048.htm
+;; [ECMA-48]: https://www.ecma-international.org/publications/standards/Ecma-048.htm
;; [vt100]: https://vt100.net/docs/vt100-ug/chapter3.html
(defconst term-control-seq-regexp
@@ -2796,12 +2814,12 @@ See `term-prompt-regexp'."
"\\(?:[\r\n\000\007\t\b\016\017]\\|"
;; some Emacs specific control sequences, implemented by
;; `term-command-hook',
- "\032[^\n]+\r?\n\\|"
+ "\032[^\n]+\n\\|"
;; a C1 escape coded character (see [ECMA-48] section 5.3 "Elements
;; of the C1 set"),
"\e\\(?:[DM78c]\\|"
;; another Emacs specific control sequence,
- "AnSiT[^\n]+\r?\n\\|"
+ "AnSiT[^\n]+\n\\|"
;; or an escape sequence (section 5.4 "Control Sequences"),
"\\[\\([\x30-\x3F]*\\)[\x20-\x2F]*[\x40-\x7E]\\)\\)")
"Regexp matching control sequences handled by term.el.")
@@ -3108,15 +3126,19 @@ See `term-prompt-regexp'."
(or (eq scroll 'this) (not save-point)))
(and (eq scroll 'others)
(not (eq selected win))))
- (goto-char term-home-marker)
- (recenter 0)
+ (when term-scroll-snap-to-bottom
+ (goto-char term-home-marker)
+ (recenter 0))
(goto-char (process-mark proc))
(if (not (pos-visible-in-window-p (point) win))
(recenter -1)))
;; Optionally scroll so that the text
;; ends at the bottom of the window.
(when (and term-scroll-show-maximum-output
- (>= (point) (process-mark proc)))
+ (>= (point) (process-mark proc))
+ (or term-scroll-snap-to-bottom
+ (not (pos-visible-in-window-p
+ (point-max) win))))
(save-excursion
(goto-char (point-max))
(recenter -1)))))
@@ -3618,8 +3640,8 @@ The top-most line is line 0."
(message "Terminal-emulator pager break help...")
(sit-for 0)
(with-electric-help
- (function (lambda ()
- (princ (substitute-command-keys
+ (lambda ()
+ (princ (substitute-command-keys
"\\<term-pager-break-map>\
Terminal-emulator MORE break.\n\
Type one of the following keys:\n\n\
@@ -3637,7 +3659,7 @@ Type one of the following keys:\n\n\
Any other key is passed through to the program
running under the terminal emulator and disables pager processing until
all pending output has been dealt with."))
- nil))))
+ nil)))
(defun term-pager-continue (new-count)
(let ((process (get-buffer-process (current-buffer))))
@@ -4090,53 +4112,6 @@ see `expand-file-name' and `substitute-in-file-name'. For completion see
(term-dynamic-complete-filename))
-(defun term-dynamic-simple-complete (stub candidates)
- "Dynamically complete STUB from CANDIDATES list.
-This function inserts completion characters at point by completing STUB from
-the strings in CANDIDATES. A completions listing may be shown in a help buffer
-if completion is ambiguous.
-
-Returns nil if no completion was inserted.
-Returns `sole' if completed with the only completion match.
-Returns `shortest' if completed with the shortest of the completion matches.
-Returns `partial' if completed as far as possible with the completion matches.
-Returns `listed' if a completion listing was shown.
-
-See also `term-dynamic-complete-filename'."
- (declare (obsolete completion-in-region "23.2"))
- (let* ((completion-ignore-case nil)
- (completions (all-completions stub candidates)))
- (cond ((null completions)
- (message "No completions of %s" stub)
- nil)
- ((= 1 (length completions)) ; Gotcha!
- (let ((completion (car completions)))
- (if (string-equal completion stub)
- (message "Sole completion")
- (insert (substring completion (length stub)))
- (message "Completed"))
- (when term-completion-addsuffix (insert " "))
- 'sole))
- (t ; There's no unique completion.
- (let ((completion (try-completion stub candidates)))
- ;; Insert the longest substring.
- (insert (substring completion (length stub)))
- (cond ((and term-completion-recexact term-completion-addsuffix
- (string-equal stub completion)
- (member completion completions))
- ;; It's not unique, but user wants shortest match.
- (insert " ")
- (message "Completed shortest")
- 'shortest)
- ((or term-completion-autolist
- (string-equal stub completion))
- ;; It's not unique, list possible completions.
- (term-dynamic-list-completions completions)
- 'listed)
- (t
- (message "Partially completed")
- 'partial)))))))
-
(defun term-dynamic-list-filename-completions ()
"List in help buffer possible completions of the filename at point."
(interactive)
@@ -4166,7 +4141,7 @@ Typing SPC flushes the help buffer."
(eq (window-buffer (posn-window (event-start first)))
(get-buffer "*Completions*"))
(memq (key-binding key)
- '(mouse-choose-completion choose-completion))))
+ '(choose-completion))))
;; If the user does choose-completion with the mouse,
;; execute the command, then delete the completion window.
(progn
@@ -4305,8 +4280,7 @@ well as the newer ports COM10 and higher."
;; `prompt': The most recently used port is provided as
;; the default value, which is used when the user
;; simply presses return.
- (if (stringp h) (format "Serial port (default %s): " h)
- "Serial port: ")
+ (format-prompt "Serial port" h)
;; `directory': Most systems have their serial ports
;; in the same directory, so start in the directory
;; of the most recently used port, or in a reasonable
@@ -4321,8 +4295,7 @@ well as the newer ports COM10 and higher."
;; serial port.
"")
(read-from-minibuffer
- (if (stringp h) (format "Serial port (default %s): " h)
- "Serial port: ")
+ (format-prompt "Serial port" h)
nil nil nil '(file-name-history . 1) nil nil))))
(if (or (null x) (and (stringp x) (zerop (length x))))
(setq x h)
@@ -4344,7 +4317,7 @@ Try to be nice by providing useful defaults and history."
(cond ((string= h serial-no-speed)
"Speed (default nil = set by port): ")
(h
- (format "Speed (default %s b/s): " h))
+ (format-prompt "Speed" (format "%s b/s" h)))
(t
(format "Speed (b/s): ")))
nil nil nil '(history . 1) nil nil)))
diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el
index 674c33b45c1..8ce7fbbcafd 100644
--- a/lisp/term/AT386.el
+++ b/lisp/term/AT386.el
@@ -1,4 +1,4 @@
-;;; AT386.el --- terminal support package for IBM AT keyboards
+;;; AT386.el --- terminal support package for IBM AT keyboards -*- lexical-binding: t -*-
;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/term/bobcat.el b/lisp/term/bobcat.el
index a32da6ae8f2..983c8cded2f 100644
--- a/lisp/term/bobcat.el
+++ b/lisp/term/bobcat.el
@@ -1,3 +1,4 @@
+;;; bobcat.el -*- lexical-binding:t -*-
(defun terminal-init-bobcat ()
"Terminal initialization function for bobcat."
diff --git a/lisp/term/cygwin.el b/lisp/term/cygwin.el
index edc64b4404d..8f0d751cf29 100644
--- a/lisp/term/cygwin.el
+++ b/lisp/term/cygwin.el
@@ -1,4 +1,4 @@
-;;; cygwin.el --- support for the Cygwin terminal
+;;; cygwin.el --- support for the Cygwin terminal -*- lexical-binding:t -*-
;;; The Cygwin terminal can't really display underlines.
diff --git a/lisp/term/internal.el b/lisp/term/internal.el
index 5e22c0f6afe..9a6f4fac1ee 100644
--- a/lisp/term/internal.el
+++ b/lisp/term/internal.el
@@ -1,4 +1,4 @@
-;;; internal.el --- support for PC internal terminal
+;;; internal.el --- support for PC internal terminal -*- lexical-binding: t -*-
;; Copyright (C) 1993-1994, 1998-1999, 2001-2020 Free Software
;; Foundation, Inc.
@@ -400,9 +400,9 @@ If TABLE is nil or omitted, `standard-display-table' is used."
;; The following alist was compiled from:
;;
;; Ralf Brown's Interrupt List. file INTERRUP.F, D-2138, Table 01400
-;; http://www.ethnologue.com/country_index.asp (official languages)
-;; http://unicode.org/onlinedat/languages.html
-;; http://unicode.org/onlinedat/countries.html
+;; https://www.ethnologue.com/country_index.asp (official languages)
+;; https://unicode.org/onlinedat/languages.html
+;; https://unicode.org/onlinedat/countries.html
;;
;; Only the official languages listed for each country.
;;
diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el
index 8a99ddf8c0d..7a92aa7adaa 100644
--- a/lisp/term/iris-ansi.el
+++ b/lisp/term/iris-ansi.el
@@ -1,4 +1,4 @@
-;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps
+;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps -*- lexical-binding: t -*-
;; Copyright (C) 1997, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/term/konsole.el b/lisp/term/konsole.el
index 8b2e7e1d5f8..4af818b4a63 100644
--- a/lisp/term/konsole.el
+++ b/lisp/term/konsole.el
@@ -1,4 +1,4 @@
-;;; konsole.el --- terminal initialization for konsole
+;;; konsole.el --- terminal initialization for konsole -*- lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
(require 'term/xterm)
diff --git a/lisp/term/linux.el b/lisp/term/linux.el
index 70730dc5844..35bd3ac0acb 100644
--- a/lisp/term/linux.el
+++ b/lisp/term/linux.el
@@ -1,4 +1,4 @@
-;; The Linux console handles Latin-1 by default.
+;; The Linux console handles Latin-1 by default. -*- lexical-binding:t -*-
(declare-function gpm-mouse-enable "t-mouse" ())
diff --git a/lisp/term/lk201.el b/lisp/term/lk201.el
index aab4110b3ae..3bcaa2ecd18 100644
--- a/lisp/term/lk201.el
+++ b/lisp/term/lk201.el
@@ -1,4 +1,4 @@
-;; Define function key sequences for DEC terminals.
+;; Define function key sequences for DEC terminals. -*- lexical-binding: t -*-
(defvar lk201-function-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/term/news.el b/lisp/term/news.el
index e01d6f64be3..33c7aa6ccaa 100644
--- a/lisp/term/news.el
+++ b/lisp/term/news.el
@@ -1,4 +1,4 @@
-;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard
+;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard -*- lexical-binding: t -*-
;; Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 184271d9e6a..8273c067f8b 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -148,9 +148,8 @@ The properties returned may include `top', `left', `height', and `width'."
(define-key global-map [?\s-|] 'shell-command-on-region)
(define-key global-map [s-kp-bar] 'shell-command-on-region)
(define-key global-map [?\C-\s- ] 'ns-do-show-character-palette)
-;; (as in Terminal.app)
-(define-key global-map [s-right] 'ns-next-frame)
-(define-key global-map [s-left] 'ns-prev-frame)
+(define-key global-map [s-right] 'move-end-of-line)
+(define-key global-map [s-left] 'move-beginning-of-line)
(define-key global-map [home] 'beginning-of-buffer)
(define-key global-map [end] 'end-of-buffer)
@@ -314,10 +313,9 @@ The overlay is assigned the face `ns-working-text-face'."
(interactive)
(ns-delete-working-text)
(let ((start (point)))
- (insert ns-working-text)
- (overlay-put (setq ns-working-overlay (make-overlay start (point)
- (current-buffer) nil t))
- 'face 'ns-working-text-face)))
+ (overlay-put (setq ns-working-overlay (make-overlay start (point)))
+ 'after-string
+ (propertize ns-working-text 'face 'ns-working-text-face))))
(defun ns-echo-working-text ()
"Echo contents of `ns-working-text' in message display area.
@@ -340,8 +338,7 @@ See `ns-insert-working-text'."
;; Still alive?
(overlay-buffer ns-working-overlay))
(with-current-buffer (overlay-buffer ns-working-overlay)
- (delete-region (overlay-start ns-working-overlay)
- (overlay-end ns-working-overlay))
+ (overlay-put ns-working-overlay 'after-string nil)
(delete-overlay ns-working-overlay)))
((integerp ns-working-overlay)
(let ((msg (current-message))
@@ -628,15 +625,21 @@ This function has been overloaded in Nextstep.")
(defvar ns-input-fontsize)
(defun ns-respond-to-change-font ()
- "Respond to changeFont: event, expecting `ns-input-font' and\n\
-`ns-input-fontsize' of new font."
+ "Set the font chosen in the font-picker panel.
+Respond to changeFont: event, expecting ns-input-font and
+ns-input-fontsize of new font."
(interactive)
- (modify-frame-parameters (selected-frame)
- (list (cons 'fontsize ns-input-fontsize)))
- (modify-frame-parameters (selected-frame)
- (list (cons 'font ns-input-font)))
- (set-frame-font ns-input-font))
-
+ (let ((face 'default))
+ (set-face-attribute face t
+ :family ns-input-font
+ :height (* 10 ns-input-fontsize))
+ (set-face-attribute face (selected-frame)
+ :family ns-input-font
+ :height (* 10 ns-input-fontsize))
+ (let ((spec (list (list t (face-attr-construct 'default)))))
+ (put face 'customized-face spec)
+ (custom-push-theme 'theme-face face 'user 'set spec)
+ (put face 'face-modified nil))))
;; Default fontset for macOS. This is mainly here to show how a fontset
;; can be set up manually. Ordinarily, fontsets are auto-created whenever
diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el
index ca6c468f525..71ee9086937 100644
--- a/lisp/term/rxvt.el
+++ b/lisp/term/rxvt.el
@@ -1,4 +1,4 @@
-;;; rxvt.el --- define function key sequences and standard colors for rxvt
+;;; rxvt.el --- define function key sequences and standard colors for rxvt -*- lexical-binding: t -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@@ -26,6 +26,16 @@
(require 'term/xterm)
+(defgroup rxvt nil
+ "(U)RXVT support."
+ :version "28.1"
+ :group 'terminals)
+
+(defcustom rxvt-set-window-title nil
+ "Whether Emacs should set window titles to an Emacs frame in RXVT."
+ :version "28.1"
+ :type 'boolean)
+
(defvar rxvt-function-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map xterm-rxvt-function-map)
@@ -171,7 +181,16 @@
(xterm-register-default-colors rxvt-standard-colors)
(rxvt-set-background-mode)
;; This recomputes all the default faces given the colors we've just set up.
- (tty-set-up-initial-frame-faces))
+ (tty-set-up-initial-frame-faces)
+
+ ;; Unconditionally enable bracketed paste mode: terminals that don't
+ ;; support it just ignore the sequence.
+ (xterm--init-bracketed-paste-mode)
+
+ (when rxvt-set-window-title
+ (xterm--init-frame-title))
+
+ (run-hooks 'terminal-init-rxvt-hook))
;; rxvt puts the default colors into an environment variable
;; COLORFGBG. We use this to set the background mode in a more
diff --git a/lisp/term/st.el b/lisp/term/st.el
new file mode 100644
index 00000000000..617664bb263
--- /dev/null
+++ b/lisp/term/st.el
@@ -0,0 +1,20 @@
+;;; st.el --- terminal initialization for st -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;;; Commentary:
+
+;; Support for the st terminal emulator.
+;; https://st.suckless.org/
+
+;;; Code:
+
+(require 'term/xterm)
+
+(defun terminal-init-st ()
+ "Terminal initialization function for st."
+ (tty-run-terminal-initialization (selected-frame) "xterm"))
+
+(provide 'term/st)
+
+;; st.el ends here
diff --git a/lisp/term/sun.el b/lisp/term/sun.el
index 41915e1b07c..7d1cd9f2cfe 100644
--- a/lisp/term/sun.el
+++ b/lisp/term/sun.el
@@ -1,4 +1,4 @@
-;;; sun.el --- keybinding for standard default sunterm keys
+;;; sun.el --- keybinding for standard default sunterm keys -*- lexical-binding: t -*-
;; Copyright (C) 1987, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index 39ca2d36276..dda7fcc3691 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -923,62 +923,8 @@ The returned value reflects the standard Emacs definition of
COLOR (see the info node `(emacs) Colors'), regardless of whether
the terminal can display it, so the return value should be the
same regardless of what display is being used."
- (let ((len (length color)))
- (cond ((and (>= len 4) ;; HTML/CSS/SVG-style "#XXYYZZ" color spec
- (eq (aref color 0) ?#)
- (member (aref color 1)
- '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
- ?a ?b ?c ?d ?e ?f
- ?A ?B ?C ?D ?E ?F)))
- ;; Translate the string "#XXYYZZ" into a list of numbers
- ;; (XX YY ZZ), scaling each to the {0..65535} range. This
- ;; follows the HTML color convention, where both "#fff" and
- ;; "#ffffff" represent the same color, white.
- (let* ((ndig (/ (- len 1) 3))
- (maxval (1- (ash 1 (* 4 ndig))))
- (i1 1)
- (i2 (+ i1 ndig))
- (i3 (+ i2 ndig))
- (i4 (+ i3 ndig)))
- (list
- (/ (* (string-to-number
- (substring color i1 i2) 16)
- 65535)
- maxval)
- (/ (* (string-to-number
- (substring color i2 i3) 16)
- 65535)
- maxval)
- (/ (* (string-to-number
- (substring color i3 i4) 16)
- 65535)
- maxval))))
- ((and (>= len 9) ;; X-style rgb:xx/yy/zz color spec
- (string= (substring color 0 4) "rgb:"))
- ;; Translate the string "rgb:XX/YY/ZZ" into a list of
- ;; numbers (XX YY ZZ), scaling each to the {0..65535}
- ;; range. "rgb:F/F/F" is white.
- (let* ((ndig (/ (- len 3) 3))
- (maxval (1- (ash 1 (* 4 (- ndig 1)))))
- (i1 4)
- (i2 (+ i1 ndig))
- (i3 (+ i2 ndig))
- (i4 (+ i3 ndig)))
- (list
- (/ (* (string-to-number
- (substring color i1 (- i2 1)) 16)
- 65535)
- maxval)
- (/ (* (string-to-number
- (substring color i2 (- i3 1)) 16)
- 65535)
- maxval)
- (/ (* (string-to-number
- (substring color i3 (1- i4)) 16)
- 65535)
- maxval))))
- (t
- (cdr (assoc color color-name-rgb-alist))))))
+ (or (color-values-from-color-spec color)
+ (cdr (assoc color color-name-rgb-alist))))
(defun tty-color-translate (color &optional frame)
"Given a color COLOR, return the index of the corresponding TTY color.
diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el
index c0e6a12b735..fc8ad80ae5c 100644
--- a/lisp/term/tvi970.el
+++ b/lisp/term/tvi970.el
@@ -1,4 +1,4 @@
-;;; tvi970.el --- terminal support for the Televideo 970
+;;; tvi970.el --- terminal support for the Televideo 970 -*- lexical-binding: t -*-
;; Copyright (C) 1992, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el
index 7ddbe38a287..2df14145231 100644
--- a/lisp/term/vt100.el
+++ b/lisp/term/vt100.el
@@ -1,4 +1,4 @@
-;;; vt100.el --- define VT100 function key sequences in function-key-map
+;;; vt100.el --- define VT100 function key sequences in function-key-map -*- lexical-binding:t -*-
;; Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/term/vt200.el b/lisp/term/vt200.el
index dde2e229068..569b79e25a1 100644
--- a/lisp/term/vt200.el
+++ b/lisp/term/vt200.el
@@ -1,3 +1,5 @@
+;;; vt200.el -*- lexical-binding:t -*-
+
;; For our purposes we can treat the vt200 and vt100 almost alike.
;; Most differences are handled by the termcap entry.
(defun terminal-init-vt200 ()
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 3e932c7593d..e866fdc36ce 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -78,12 +78,8 @@
(require 'dnd)
(require 'w32-vars)
-;; Keep an obsolete alias for w32-focus-frame and w32-select-font in case
-;; they are used by code outside Emacs.
-(define-obsolete-function-alias 'w32-focus-frame 'x-focus-frame "23.1")
(declare-function x-select-font "w32font.c"
(&optional frame exclude-proportional))
-(define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1")
(defvar w32-color-map) ;; defined in w32fns.c
(make-obsolete 'w32-default-color-map nil "24.1")
@@ -231,6 +227,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;;; Set default known names for external libraries
(setq dynamic-library-alist
(list
+ '(gdiplus "gdiplus.dll")
+ '(shlwapi "shlwapi.dll")
'(xpm "libxpm.dll" "xpm4.dll" "libXpm-nox4.dll")
;; Versions of libpng 1.4.x and later are incompatible with
;; earlier versions. Set up the list of libraries according to
diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el
index 9e9fc4dd7de..f06563ebebf 100644
--- a/lisp/term/wyse50.el
+++ b/lisp/term/wyse50.el
@@ -1,4 +1,4 @@
-;;; wyse50.el --- terminal support code for Wyse 50
+;;; wyse50.el --- terminal support code for Wyse 50 -*- lexical-binding: t -*-
;; Copyright (C) 1989, 1993-1994, 2001-2020 Free Software Foundation,
;; Inc.
@@ -126,9 +126,9 @@
;; On such terminals, Emacs should sacrifice the first and last character of
;; each mode line, rather than a whole screen column!
(add-hook 'kill-emacs-hook
- (function (lambda () (interactive)
- (send-string-to-terminal
- (concat "\ea23R" (1+ (frame-width)) "C\eG0"))))))
+ (lambda () (interactive)
+ (send-string-to-terminal
+ (concat "\ea23R" (1+ (frame-width)) "C\eG0")))))
(defun enable-arrow-keys ()
"To be called by `tty-setup-hook'. Overrides 6 Emacs standard keys
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 5b8feb14a5e..42a6f4030e5 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1407,13 +1407,13 @@ This returns an error if any Emacs frames are X frames."
("etc/images/right-arrow" . ("go-next" "gtk-go-forward"))
("etc/images/home" . ("go-home" "gtk-home"))
("etc/images/jump-to" . ("go-jump" "gtk-jump-to"))
- ("etc/images/index" . "gtk-index")
+ ("etc/images/index" . ("gtk-search" "gtk-index"))
("etc/images/exit" . ("application-exit" "gtk-quit"))
("etc/images/cancel" . "gtk-cancel")
("etc/images/info" . ("dialog-information" "gtk-info"))
("etc/images/bookmark_add" . "n:bookmark_add")
;; Used in Gnus and/or MH-E:
- ("etc/images/attach" . "gtk-attach")
+ ("etc/images/attach" . ("mail-attachment" "gtk-attach"))
("etc/images/connect" . "gtk-connect")
("etc/images/contact" . "gtk-contact")
("etc/images/delete" . ("edit-delete" "gtk-delete"))
@@ -1425,14 +1425,16 @@ This returns an error if any Emacs frames are X frames."
("etc/images/lock" . "gtk-lock")
("etc/images/next-page" . "gtk-next-page")
("etc/images/refresh" . ("view-refresh" "gtk-refresh"))
+ ("etc/images/search-replace" . "edit-find-replace")
("etc/images/sort-ascending" . ("view-sort-ascending" "gtk-sort-ascending"))
("etc/images/sort-column-ascending" . "gtk-sort-column-ascending")
("etc/images/sort-criteria" . "gtk-sort-criteria")
("etc/images/sort-descending" . ("view-sort-descending"
"gtk-sort-descending"))
("etc/images/sort-row-ascending" . "gtk-sort-row-ascending")
+ ("etc/images/spell" . ("tools-check-spelling" "gtk-spell-check"))
("images/gnus/toggle-subscription" . "gtk-task-recurring")
- ("images/mail/compose" . "gtk-mail-compose")
+ ("images/mail/compose" . ("mail-message-new" "gtk-mail-compose"))
("images/mail/copy" . "gtk-mail-copy")
("images/mail/forward" . "gtk-mail-forward")
("images/mail/inbox" . "gtk-inbox")
@@ -1442,7 +1444,7 @@ This returns an error if any Emacs frames are X frames."
("images/mail/reply-all" . "gtk-mail-reply-to-all")
("images/mail/reply" . "gtk-mail-reply")
("images/mail/save-draft" . "gtk-mail-handling")
- ("images/mail/send" . "gtk-mail-send")
+ ("images/mail/send" . ("mail-send" "gtk-mail-send"))
("images/mail/spam" . "gtk-spam")
;; Used for GDB Graphical Interface
("images/gud/break" . "gtk-no")
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index eb07bb4d910..90e8d360c1b 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -1,10 +1,10 @@
-;;; artist.el --- draw ascii graphics with your mouse
+;;; artist.el --- draw ascii graphics with your mouse -*- lexical-binding: t -*-
;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
;; Author: Tomas Abrahamsson <tab@lysator.liu.se>
;; Keywords: mouse
-;; Version: 1.2.6
+;; Old-Version: 1.2.6
;; Release-date: 6-Aug-2004
;; Location: http://www.lysator.liu.se/~tab/artist/
@@ -115,8 +115,6 @@
;;; Requirements:
-;; Artist requires Emacs 19.28 or higher.
-;;
;; Artist requires the `rect' package (which comes with Emacs) to be
;; loadable, unless the variable `artist-interface-with-rect' is set
;; to nil.
@@ -127,9 +125,6 @@
;;; Known bugs:
-;; The shifted operations are not available when drawing with the mouse
-;; in Emacs 19.29 and 19.30.
-;;
;; It is not possible to change between shifted and unshifted operation
;; while drawing with the mouse. (See the comment in the function
;; artist-shift-has-changed for further details.)
@@ -1849,9 +1844,7 @@ Return a list (RETURN-CODE STDOUT STDERR)."
nil))
(tmp-stdout-buffer (get-buffer-create
(concat "*artist-" program "*")))
- (tmp-stderr-file-name (make-temp-file "artist-stdout."))
- (binary-process-input nil) ; for msdos
- (binary-process-output nil))
+ (tmp-stderr-file-name (make-temp-file "artist-stdout.")))
;; Prepare stdin
(if stdin (artist-string-to-file stdin tmp-stdin-file-name))
@@ -1999,25 +1992,11 @@ The replacement is used to convert tabs and new-lines to spaces."
(defun artist-replace-chars (new-char count)
"Replace characters at point with NEW-CHAR. COUNT chars are replaced."
- ;; Check that the variable exists first. The doc says it was added in 19.23.
- (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
- (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
- ;; This is a bug workaround for Emacs 20, versions up to 20.3:
- ;; The self-insert-command doesn't care about the overwrite-mode,
- ;; so the insertion is done in the same way as in picture mode.
- ;; This seems to be a little bit slower.
- (let* ((replaced-c (artist-get-replacement-char new-char))
- (replaced-s (make-string count replaced-c)))
- (artist-move-to-xy (+ (artist-current-column) count)
- (artist-current-line))
- (delete-char (- count))
- (insert replaced-s))
- ;; In emacs-19, the self-insert-command works better
- (let ((overwrite-mode 'overwrite-mode-textual)
- (fill-column 32765) ; Large :-)
- (blink-matching-paren nil))
- (setq last-command-event (artist-get-replacement-char new-char))
- (self-insert-command count))))
+ (let ((overwrite-mode 'overwrite-mode-textual)
+ (fill-column 32765) ; Large :-)
+ (blink-matching-paren nil))
+ (setq last-command-event (artist-get-replacement-char new-char))
+ (self-insert-command count)))
(defsubst artist-replace-string (string &optional see-thru)
"Replace contents at point with STRING.
@@ -2740,7 +2719,7 @@ SHAPE-INFO is a list of four straight lines."
;; Filling rectangles and squares
;;
-(defun artist-fill-rect (rect x1 y1 x2 y2)
+(defun artist-fill-rect (_rect x1 y1 x2 y2)
"Fill rectangle RECT from X1,Y1 to X2,Y2."
(let ((x (1+ (min x1 x2)))
(y (1+ (min y1 y2)))
@@ -2752,7 +2731,7 @@ SHAPE-INFO is a list of four straight lines."
(artist-replace-chars artist-fill-char w)
(setq y (1+ y))))))
-(defun artist-fill-square (square x1 y1 x2 y2)
+(defun artist-fill-square (_square x1 y1 x2 y2)
"Fill a SQUARE from X1,Y1 to X2,Y2."
(let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
(new-x1 (elt square-corners 0))
@@ -2814,7 +2793,7 @@ to append to the end of the list, when doing free-hand drawing)."
(setq artist-key-poly-point-list (list (cons x1 y1))))
-(defun artist-pen-set-arrow-points (x1 y1)
+(defun artist-pen-set-arrow-points (_x1 _y1)
"Set arrow points for pen drawing using X1, Y1.
Also, the `artist-key-poly-point-list' is reversed."
@@ -3015,11 +2994,11 @@ Returns a list of points. Each point is on the form (X1 . Y1)."
;; Step to next spray point
(setq spray-points (cdr spray-points)))))
-(defun artist-spray-clear-circle (circle x1 y1 x2 y2)
+(defun artist-spray-clear-circle (circle _x1 _y1 _x2 _y2)
"Clear circle CIRCLE at X1, Y1 through X2, Y2."
(artist-undraw-circle circle))
-(defun artist-spray-set-radius (circle x1 y1 x2 y2)
+(defun artist-spray-set-radius (_circle x1 y1 x2 y2)
"Set spray radius from CIRCLE at X1, Y1 through X2, Y2."
(let ((dx (- x2 x1))
(dy (- y2 y1)))
@@ -3512,8 +3491,7 @@ POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE].
The Y-RADIUS must be 0, but the X-RADIUS must not be 0."
- (let ((point-list nil)
- (width (max (- (abs (* 2 x-radius)) 1)))
+ (let ((width (max (- (abs (* 2 x-radius)) 1)))
(left-edge (1+ (- x1 (abs x-radius))))
(line-char (if artist-line-char-set artist-line-char ?-))
(i 0)
@@ -3621,7 +3599,7 @@ FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]."
;
; Filling ellipses
;
-(defun artist-fill-ellipse (ellipse x y x-radius y-radius)
+(defun artist-fill-ellipse (ellipse _x _y _x-radius _y-radius)
"Fill an ELLIPSE centered at X,Y with radius X-RADIUS and Y-RADIUS."
(let ((fill-info (aref (artist-2point-get-shapeinfo ellipse) 1)))
(mapcar
@@ -3741,11 +3719,11 @@ original contents of that area in the buffer."
(setq x (1+ x)))
last-x)))
-(defun artist-ff-is-topmost-line (x y)
+(defun artist-ff-is-topmost-line (_x y)
"Determine whether the position X,Y is on the topmost line or not."
(= y 0))
-(defun artist-ff-is-bottommost-line (x y)
+(defun artist-ff-is-bottommost-line (_x y)
"Determine whether the position X,Y is on the bottommost line or not."
(save-excursion
(goto-char (point-max))
@@ -3761,7 +3739,6 @@ original contents of that area in the buffer."
(defun artist-flood-fill (x1 y1)
"Flood-fill starting at X1, Y1. Fill with the char in `artist-fill-char'."
(let ((stack nil)
- (input-queue nil)
;; We are flood-filling the area that has this character.
(c (artist-get-char-at-xy-conv x1 y1))
(artist-fill-char (if artist-fill-char-set
@@ -3903,7 +3880,7 @@ Optional argument STATE can be used to set state (default is nil)."
(setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn))))
-(defun artist-set-arrow-points-for-2points (shape x1 y1 x2 y2)
+(defun artist-set-arrow-points-for-2points (shape _x1 _y1 _x2 _y2)
"Generic function for setting arrow-points for 2-point shapes.
The 2-point shape SHAPE is drawn from X1, Y1 to X2, Y2."
(let* ((endpoint1 (artist-2point-get-endpoint1 shape))
@@ -3925,28 +3902,24 @@ The 2-point shape SHAPE is drawn from X1, Y1 to X2, Y2."
;; on the draw-how
;;
-(defun artist-key-undraw-continously (x y)
+(defun artist-key-undraw-continously (_x _y)
"Undraw current continuous shape with point at X, Y."
;; No undraw-info for continuous shapes
nil)
-(defun artist-key-undraw-poly (x y)
+(defun artist-key-undraw-poly (_x _y)
"Undraw current poly shape with point at X, Y."
- (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
- (x1 (artist-endpoint-get-x artist-key-endpoint1))
- (y1 (artist-endpoint-get-y artist-key-endpoint1)))
+ (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go)))
(artist-funcall undraw-fn artist-key-shape)))
-(defun artist-key-undraw-1point (x y)
+(defun artist-key-undraw-1point (_x _y)
"Undraw current 1-point shape at X, Y."
;; No undraw-info for 1-point shapes
nil)
-(defun artist-key-undraw-2points (x y)
+(defun artist-key-undraw-2points (_x _y)
"Undraw current 2-point shape at X, Y."
- (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
- (x1 (artist-endpoint-get-x artist-key-endpoint1))
- (y1 (artist-endpoint-get-y artist-key-endpoint1)))
+ (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go)))
(artist-funcall undraw-fn artist-key-shape)))
(defun artist-key-undraw-common ()
@@ -4090,7 +4063,7 @@ Trimming here means removing white space at end of a line."
(setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))))
-(defun artist-key-do-continously-1point (x y)
+(defun artist-key-do-continously-1point (_x _y)
"Update current 1-point shape at X,Y."
;; Nothing to do continuously for operations
;; where we have only one input point
@@ -4290,8 +4263,7 @@ If optional argument THIS-IS-LAST-POINT is non-nil, this point is the last."
(defun artist-key-set-point-1point (x y)
"Set point for current 1-point shape at X,Y."
- (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
- (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
+ (let ((init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
(prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
(exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
(draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
@@ -4821,7 +4793,7 @@ If optional argument STATE is positive, turn borders on."
(orig-draw-region-min-y artist-draw-region-min-y)
(orig-draw-region-max-y artist-draw-region-max-y)
(orig-pointer-shape (if (eq window-system 'x) x-pointer-shape nil))
- (echoq-keystrokes 10000) ; a lot of seconds
+ (echo-keystrokes 0) ; Don't echo unfinished commands.
;; Remember original binding for the button-up event to this
;; button-down event.
(key (artist-compute-up-event-key ev))
@@ -4937,7 +4909,7 @@ If optional argument STATE is positive, turn borders on."
;; Mouse routines
;;
-(defsubst artist-shift-has-changed (shift-state ev)
+(defsubst artist-shift-has-changed (_shift-state _ev)
"From the last SHIFT-STATE and EV, determine if the shift-state has changed."
;; This one simply doesn't work.
;;
@@ -4962,6 +4934,12 @@ If optional argument STATE is positive, turn borders on."
(cons (+ window-x window-start-x)
(+ window-y window-start-y))))
+(defun artist--adjust-x (x)
+ "Adjust the X position wrt. `display-line-numbers-mode'."
+ (let ((adjust (line-number-display-width)))
+ (if (= adjust 0)
+ x
+ (- x adjust 2))))
(defun artist-mouse-draw-continously (ev)
"Generic function for shapes that require 1 point as input.
@@ -4983,10 +4961,9 @@ The event, EV, is the mouse event."
(ev-start (event-start ev))
(initial-win (posn-window ev-start))
(ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
- (x1 (car ev-start-pos))
+ (x1 (artist--adjust-x (car ev-start-pos)))
(y1 (cdr ev-start-pos))
- (shape)
- (timer))
+ (timer nil))
(select-window (posn-window ev-start))
(artist-funcall init-fn x1 y1)
(if (not artist-rubber-banding)
@@ -5000,7 +4977,7 @@ The event, EV, is the mouse event."
(member 'down (event-modifiers ev)))
(setq ev-start-pos (artist-coord-win-to-buf
(posn-col-row (event-start ev))))
- (setq x1 (car ev-start-pos))
+ (setq x1 (artist--adjust-x (car ev-start-pos)))
(setq y1 (cdr ev-start-pos))
;; Cancel previous timer
@@ -5030,7 +5007,7 @@ The event, EV, is the mouse event."
(setq draw-fn (artist-go-get-draw-fn-from-symbol op))))
;; Draw the new shape
- (setq shape (artist-funcall draw-fn x1 y1))
+ (artist-funcall draw-fn x1 y1)
(artist-move-to-xy x1 y1)
;; Start the timer to call `draw-fn' repeatedly every
@@ -5080,7 +5057,7 @@ The event, EV, is the mouse event."
(ev-start (event-start ev))
(initial-win (posn-window ev-start))
(ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
- (x1-last (car ev-start-pos))
+ (x1-last (artist--adjust-x (car ev-start-pos)))
(y1-last (cdr ev-start-pos))
(x2 x1-last)
(y2 y1-last)
@@ -5172,7 +5149,7 @@ The event, EV, is the mouse event."
;;
(setq ev-start-pos (artist-coord-win-to-buf
(posn-col-row (event-start ev))))
- (setq x2 (car ev-start-pos))
+ (setq x2 (artist--adjust-x (car ev-start-pos)))
(setq y2 (cdr ev-start-pos))
;; Draw the new shape (if not rubber-banding, place both marks)
@@ -5199,7 +5176,7 @@ The event, EV, is the mouse event."
;; set x2 and y2
(setq ev-start-pos (artist-coord-win-to-buf
(posn-col-row (event-start ev))))
- (setq x2 (car ev-start-pos))
+ (setq x2 (artist--adjust-x (car ev-start-pos)))
(setq y2 (cdr ev-start-pos))
;; First undraw last shape
@@ -5275,7 +5252,6 @@ Operation is done once. The event, EV, is the mouse event."
(shifted (artist-go-get-symbol-shift artist-curr-go t))
(shift-state (artist-event-is-shifted ev))
(op (if shift-state shifted unshifted))
- (draw-how (artist-go-get-draw-how-from-symbol op))
(init-fn (artist-go-get-init-fn-from-symbol op))
(prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
(exit-fn (artist-go-get-exit-fn-from-symbol op))
@@ -5284,7 +5260,7 @@ Operation is done once. The event, EV, is the mouse event."
(arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
(ev-start (event-start ev))
(ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
- (x1 (car ev-start-pos))
+ (x1 (artist--adjust-x (car ev-start-pos)))
(y1 (cdr ev-start-pos)))
(select-window (posn-window ev-start))
(artist-funcall init-fn x1 y1)
@@ -5318,7 +5294,7 @@ The event, EV, is the mouse event."
(ev-start (event-start ev))
(initial-win (posn-window ev-start))
(ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
- (x1 (car ev-start-pos))
+ (x1 (artist--adjust-x (car ev-start-pos)))
(y1 (cdr ev-start-pos))
(x2)
(y2)
@@ -5332,7 +5308,7 @@ The event, EV, is the mouse event."
(member 'down (event-modifiers ev)))
(setq ev-start-pos (artist-coord-win-to-buf
(posn-col-row (event-start ev))))
- (setq x2 (car ev-start-pos))
+ (setq x2 (artist--adjust-x (car ev-start-pos)))
(setq y2 (cdr ev-start-pos))
(if (not (eq initial-win (posn-window (event-start ev))))
@@ -5407,8 +5383,7 @@ The event, EV, is the mouse event."
(interactive)
(require 'reporter)
(if (y-or-n-p "Do you want to submit a bug report on Artist? ")
- (let ((to artist-maintainer-address)
- (vars '(window-system
+ (let ((vars '(window-system
window-system-version
;;
artist-rubber-banding
@@ -5423,10 +5398,9 @@ The event, EV, is the mouse event."
artist-arrow-point-2)))
;; Remove those variables from vars that are not bound
(mapc
- (function
- (lambda (x)
- (if (not (and (boundp x) (symbol-value x)))
- (setq vars (delq x vars))))) vars)
+ (lambda (x)
+ (if (not (and (boundp x) (symbol-value x)))
+ (setq vars (delq x vars)))) vars)
(reporter-submit-bug-report
artist-maintainer-address
(concat "artist.el " artist-version)
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 670e763814c..fcf63ed5ecf 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -85,8 +85,8 @@ If this is a function, call it to generate the initial field text."
:type '(choice (const :tag "None" nil)
(string :tag "Initial text")
(function :tag "Initialize Function")
- (const :tag "Default" t)))
-(put 'bibtex-include-OPTkey 'risky-local-variable t)
+ (const :tag "Default" t))
+ :risky t)
(defcustom bibtex-user-optional-fields
'(("annote" "Personal annotation (ignored)"))
@@ -97,8 +97,8 @@ in `bibtex-BibTeX-entry-alist' (which see)."
:type '(repeat (group (string :tag "Field")
(string :tag "Comment")
(option (choice :tag "Init"
- (const nil) string function)))))
-(put 'bibtex-user-optional-fields 'risky-local-variable t)
+ (const nil) string function))))
+ :risky t)
(defcustom bibtex-entry-format
'(opts-or-alts required-fields numerical-fields)
@@ -148,20 +148,18 @@ The value nil means do no formatting at all."
(const unify-case)
(const braces)
(const strings)
- (const sort-fields))))
-(put 'bibtex-entry-format 'safe-local-variable
- (lambda (x)
- (or (eq x t)
- (let ((OK t))
- (while (consp x)
- (unless (memq (pop x)
- '(opts-or-alts required-fields numerical-fields
- page-dashes whitespace inherit-booktitle realign
- last-comma delimiters unify-case braces strings
- sort-fields))
- (setq OK nil)))
- (unless (null x) (setq OK nil))
- OK))))
+ (const sort-fields)))
+ :safe (lambda (x)
+ (or (eq x t)
+ (let ((ok t))
+ (while (consp x)
+ (unless (memq (pop x)
+ '( opts-or-alts required-fields numerical-fields
+ page-dashes whitespace inherit-booktitle
+ realign last-comma delimiters unify-case
+ braces strings sort-fields ))
+ (setq ok nil)))
+ (unless x ok)))))
(defcustom bibtex-field-braces-alist nil
"Alist of field regexps that \\[bibtex-clean-entry] encloses by braces.
@@ -207,9 +205,8 @@ See also `bibtex-sort-ignore-string-entries'."
(const plain)
(const crossref)
(const entry-class)
- (const t)))
-(put 'bibtex-maintain-sorted-entries 'safe-local-variable
- (lambda (a) (memq a '(nil t plain crossref entry-class))))
+ (const t))
+ :safe (lambda (a) (memq a '(nil t plain crossref entry-class))))
(defcustom bibtex-sort-entry-class
'(("String")
@@ -223,18 +220,17 @@ to all entries not explicitly mentioned."
:group 'bibtex
:type '(repeat (choice :tag "Class"
(const :tag "catch-all" (catch-all))
- (repeat :tag "Entry type" string))))
-(put 'bibtex-sort-entry-class 'safe-local-variable
- (lambda (x) (let ((OK t))
- (while (consp x)
- (let ((y (pop x)))
- (while (consp y)
- (let ((z (pop y)))
- (unless (or (stringp z) (eq z 'catch-all))
- (setq OK nil))))
- (unless (null y) (setq OK nil))))
- (unless (null x) (setq OK nil))
- OK)))
+ (repeat :tag "Entry type" string)))
+ :safe (lambda (x)
+ (let ((ok t))
+ (while (consp x)
+ (let ((y (pop x)))
+ (while (consp y)
+ (let ((z (pop y)))
+ (unless (or (stringp z) (eq z 'catch-all))
+ (setq ok nil))))
+ (when y (setq ok nil))))
+ (unless x ok))))
(defcustom bibtex-sort-ignore-string-entries t
"If non-nil, BibTeX @String entries are not sort-significant.
@@ -391,13 +387,13 @@ If parsing fails, try to set this variable to nil."
(("author")
("howpublished" "The way in which the booklet was published")
("address") ("month") ("year") ("note")))
- ("PhdThesis" "PhD. Thesis"
+ ("PhdThesis" "PhD Thesis"
(("author")
- ("title" "Title of the PhD. thesis")
- ("school" "School where the PhD. thesis was written")
+ ("title" "Title of the PhD thesis")
+ ("school" "School where the PhD thesis was written")
("year"))
nil
- (("type" "Type of the PhD. thesis")
+ (("type" "Type of the PhD thesis")
("address" "Address of the school (if not part of field \"school\") or country")
("month") ("note")))
("MastersThesis" "Master's Thesis"
@@ -440,7 +436,7 @@ If parsing fails, try to set this variable to nil."
"Alist of BibTeX entry types and their associated fields.
Elements are lists (ENTRY-TYPE DOC REQUIRED CROSSREF OPTIONAL).
ENTRY-TYPE is the type of a BibTeX entry.
-DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used.
+DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used.
REQUIRED is a list of required fields.
CROSSREF is a list of fields that are optional if a crossref field
is present; but these fields are required otherwise.
@@ -459,8 +455,8 @@ ALTERNATIVE if non-nil is an integer that numbers sets of
alternatives, starting from zero."
:group 'bibtex
:version "26.1" ; add Conference
- :type 'bibtex-entry-alist)
-(put 'bibtex-BibTeX-entry-alist 'risky-local-variable t)
+ :type 'bibtex-entry-alist
+ :risky t)
(defcustom bibtex-biblatex-entry-alist
;; Compare in biblatex documentation:
@@ -471,8 +467,8 @@ alternatives, starting from zero."
("year" nil nil 0) ("date" nil nil 0))
nil
(("translator") ("annotator") ("commentator") ("subtitle") ("titleaddon")
- ("editor") ("editora") ("editorb") ("editorc")
- ("journalsubtitle") ("issuetitle") ("issuesubtitle")
+ ("editor") ("editora") ("editorb") ("editorc") ("journalsubtitle")
+ ("journaltitleaddon") ("issuetitle") ("issuesubtitle") ("issuetitleaddon")
("language") ("origlanguage") ("series") ("volume") ("number") ("eid")
("issue") ("month") ("pages") ("version") ("note") ("issn")
("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
@@ -485,7 +481,7 @@ alternatives, starting from zero."
("introduction") ("foreword") ("afterword") ("subtitle") ("titleaddon")
("maintitle") ("mainsubtitle") ("maintitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
- ("series") ("number") ("note") ("publisher") ("location") ("isbn")
+ ("series") ("number") ("note") ("publisher") ("location") ("isbn") ("eid")
("chapter") ("pages") ("pagetotal") ("addendum") ("pubstate") ("doi")
("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("MVBook" "Multi-Volume Book"
@@ -506,7 +502,7 @@ alternatives, starting from zero."
("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
- ("series") ("number") ("note") ("publisher") ("location") ("isbn")
+ ("series") ("number") ("note") ("publisher") ("location") ("isbn") ("eid")
("chapter") ("pages") ("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("BookInBook" "Book in Collection" ; same as @inbook
@@ -517,7 +513,7 @@ alternatives, starting from zero."
("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
- ("series") ("number") ("note") ("publisher") ("location") ("isbn")
+ ("series") ("number") ("note") ("publisher") ("location") ("isbn") ("eid")
("chapter") ("pages") ("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("SuppBook" "Supplemental Material in a Book" ; same as @inbook
@@ -528,7 +524,7 @@ alternatives, starting from zero."
("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
- ("series") ("number") ("note") ("publisher") ("location") ("isbn")
+ ("series") ("number") ("note") ("publisher") ("location") ("isbn") ("eid")
("chapter") ("pages") ("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("Booklet" "Booklet (Bound, but no Publisher)"
@@ -536,9 +532,9 @@ alternatives, starting from zero."
("year" nil nil 1) ("date" nil nil 1))
nil
(("subtitle") ("titleaddon") ("language") ("howpublished") ("type")
- ("note") ("location") ("chapter") ("pages") ("pagetotal") ("addendum")
- ("pubstate") ("doi") ("eprint") ("eprintclass") ("eprinttype")
- ("url") ("urldate")))
+ ("note") ("location") ("eid") ("chapter") ("pages") ("pagetotal")
+ ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
+ ("eprinttype") ("url") ("urldate")))
("Collection" "Single-Volume Collection"
(("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
nil
@@ -547,8 +543,8 @@ alternatives, starting from zero."
("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("language") ("origlanguage") ("volume")
("part") ("edition") ("volumes") ("series") ("number") ("note")
- ("publisher") ("location") ("isbn") ("chapter") ("pages") ("pagetotal")
- ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
+ ("publisher") ("location") ("isbn") ("eid") ("chapter") ("pages")
+ ("pagetotal") ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
("eprinttype") ("url") ("urldate")))
("MVCollection" "Multi-Volume Collection"
(("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
@@ -562,32 +558,40 @@ alternatives, starting from zero."
("InCollection" "Article in a Collection"
(("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
(("booktitle"))
- (("editor") ("editora") ("editorb") ("editorc") ("translator") ("annotator")
- ("commentator") ("introduction") ("foreword") ("afterword")
+ (("editor") ("editora") ("editorb") ("editorc") ("translator")
+ ("annotator") ("commentator") ("introduction") ("foreword") ("afterword")
("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition")
("volumes") ("series") ("number") ("note") ("publisher") ("location")
- ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("isbn") ("eid") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("SuppCollection" "Supplemental Material in a Collection" ; same as @incollection
- (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
(("booktitle"))
- (("editora") ("editorb") ("editorc") ("translator") ("annotator")
- ("commentator") ("introduction") ("foreword") ("afterword")
+ (("editor") ("editora") ("editorb") ("editorc") ("translator")
+ ("annotator") ("commentator") ("introduction") ("foreword") ("afterword")
("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition")
("volumes") ("series") ("number") ("note") ("publisher") ("location")
- ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("isbn") ("eid") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("Dataset" "Data Set"
+ (("author" nil nil 0) ("editor" nil nil 0) ("title")
+ ("year" nil nil 1) ("date" nil nil 1))
+ nil
+ (("subtitle") ("titleaddon") ("language") ("edition") ("type") ("series")
+ ("number") ("version") ("note") ("organization") ("publisher")
+ ("location") ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
+ ("eprinttype") ("url") ("urldate")))
("Manual" "Technical Manual"
(("author" nil nil 0) ("editor" nil nil 0) ("title")
("year" nil nil 1) ("date" nil nil 1))
nil
(("subtitle") ("titleaddon") ("language") ("edition")
("type") ("series") ("number") ("version") ("note")
- ("organization") ("publisher") ("location") ("isbn") ("chapter")
+ ("organization") ("publisher") ("location") ("isbn") ("eid") ("chapter")
("pages") ("pagetotal") ("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("Misc" "Miscellaneous"
@@ -596,35 +600,37 @@ alternatives, starting from zero."
nil
(("subtitle") ("titleaddon") ("language") ("howpublished") ("type")
("version") ("note") ("organization") ("location")
- ("date") ("month") ("year") ("addendum") ("pubstate")
+ ("month") ("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("Online" "Online Resource"
(("author" nil nil 0) ("editor" nil nil 0) ("title")
- ("year" nil nil 1) ("date" nil nil 1) ("url"))
+ ("year" nil nil 1) ("date" nil nil 1)
+ ("doi" nil nil 2) ("eprint" nil nil 2) ("url" nil nil 2))
nil
(("subtitle") ("titleaddon") ("language") ("version") ("note")
- ("organization") ("date") ("month") ("year") ("addendum")
- ("pubstate") ("urldate")))
+ ("organization") ("month") ("addendum")
+ ("pubstate") ("eprintclass") ("eprinttype") ("urldate")))
("Patent" "Patent"
(("author") ("title") ("number") ("year" nil nil 0) ("date" nil nil 0))
nil
(("holder") ("subtitle") ("titleaddon") ("type") ("version") ("location")
- ("note") ("date") ("month") ("year") ("addendum") ("pubstate")
+ ("note") ("month") ("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("Periodical" "Complete Issue of a Periodical"
(("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
nil
- (("editora") ("editorb") ("editorc") ("subtitle") ("issuetitle")
- ("issuesubtitle") ("language") ("series") ("volume") ("number") ("issue")
- ("date") ("month") ("year") ("note") ("issn") ("addendum") ("pubstate")
+ (("editora") ("editorb") ("editorc") ("subtitle") ("titleaddon")
+ ("issuetitle") ("issuesubtitle") ("issuetitleaddon") ("language")
+ ("series") ("volume") ("number") ("issue")
+ ("month") ("note") ("issn") ("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("SuppPeriodical" "Supplemental Material in a Periodical" ; same as @article
(("author") ("title") ("journaltitle")
("year" nil nil 0) ("date" nil nil 0))
nil
(("translator") ("annotator") ("commentator") ("subtitle") ("titleaddon")
- ("editor") ("editora") ("editorb") ("editorc")
- ("journalsubtitle") ("issuetitle") ("issuesubtitle")
+ ("editor") ("editora") ("editorb") ("editorc") ("journalsubtitle")
+ ("journaltitleaddon") ("issuetitle") ("issuesubtitle") ("issuetitleaddon")
("language") ("origlanguage") ("series") ("volume") ("number") ("eid")
("issue") ("month") ("pages") ("version") ("note") ("issn")
("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
@@ -632,19 +638,19 @@ alternatives, starting from zero."
("Proceedings" "Single-Volume Conference Proceedings"
(("title") ("year" nil nil 0) ("date" nil nil 0))
nil
- (("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
- ("maintitleaddon") ("eventtitle") ("eventdate") ("venue") ("language")
- ("editor")
- ("volume") ("part") ("volumes") ("series") ("number") ("note")
- ("organization") ("publisher") ("location") ("month")
- ("isbn") ("chapter") ("pages") ("pagetotal") ("addendum") ("pubstate")
- ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ (("editor") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ ("maintitleaddon") ("eventtitle") ("eventtitleaddon") ("eventdate")
+ ("venue") ("language") ("volume") ("part") ("volumes") ("series")
+ ("number") ("note") ("organization") ("publisher") ("location") ("month")
+ ("isbn") ("eid") ("chapter") ("pages") ("pagetotal") ("addendum")
+ ("pubstate") ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url")
+ ("urldate")))
("MVProceedings" "Multi-Volume Conference Proceedings"
- (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("title") ("year" nil nil 0) ("date" nil nil 0))
nil
- (("subtitle") ("titleaddon") ("eventtitle") ("eventdate") ("venue")
- ("language") ("volumes") ("series") ("number") ("note")
- ("organization") ("publisher") ("location") ("month")
+ (("editor") ("subtitle") ("titleaddon") ("eventtitle") ("eventtitleaddon")
+ ("eventdate") ("venue") ("language") ("volumes") ("series") ("number")
+ ("note") ("organization") ("publisher") ("location") ("month")
("isbn") ("pagetotal") ("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("InProceedings" "Article in Conference Proceedings"
@@ -652,9 +658,9 @@ alternatives, starting from zero."
(("booktitle"))
(("editor") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
- ("eventtitle") ("eventdate") ("venue") ("language")
+ ("eventtitle") ("eventtitleaddon") ("eventdate") ("venue") ("language")
("volume") ("part") ("volumes") ("series") ("number") ("note")
- ("organization") ("publisher") ("location") ("month") ("isbn")
+ ("organization") ("publisher") ("location") ("month") ("isbn") ("eid")
("chapter") ("pages") ("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("Reference" "Single-Volume Work of Reference" ; same as @collection
@@ -665,8 +671,8 @@ alternatives, starting from zero."
("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("language") ("origlanguage") ("volume")
("part") ("edition") ("volumes") ("series") ("number") ("note")
- ("publisher") ("location") ("isbn") ("chapter") ("pages") ("pagetotal")
- ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
+ ("publisher") ("location") ("isbn") ("eid") ("chapter") ("pages")
+ ("pagetotal") ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
("eprinttype") ("url") ("urldate")))
("MVReference" "Multi-Volume Work of Reference" ; same as @mvcollection
(("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
@@ -678,44 +684,53 @@ alternatives, starting from zero."
("location") ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("InReference" "Article in a Work of Reference" ; same as @incollection
- (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
(("booktitle"))
- (("editora") ("editorb") ("editorc") ("translator") ("annotator")
- ("commentator") ("introduction") ("foreword") ("afterword")
+ (("editor") ("editora") ("editorb") ("editorc") ("translator")
+ ("annotator") ("commentator") ("introduction") ("foreword") ("afterword")
("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition")
("volumes") ("series") ("number") ("note") ("publisher") ("location")
- ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
+ ("isbn") ("eid") ("chapter") ("pages") ("addendum") ("pubstate") ("doi")
("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("Report" "Technical or Research Report"
(("author") ("title") ("type") ("institution")
("year" nil nil 0) ("date" nil nil 0))
nil
(("subtitle") ("titleaddon") ("language") ("number") ("version") ("note")
- ("location") ("month") ("isrn") ("chapter") ("pages") ("pagetotal")
- ("addendum") ("pubstate")
+ ("location") ("month") ("isrn") ("eid") ("chapter") ("pages")
+ ("pagetotal") ("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
- ("Thesis" "PhD. or Master's Thesis"
+ ("Software" "Computer Software" ; Same as @misc.
+ (("author" nil nil 0) ("editor" nil nil 0) ("title")
+ ("year" nil nil 1) ("date" nil nil 1))
+ nil
+ (("subtitle") ("titleaddon") ("language") ("howpublished") ("type")
+ ("version") ("note") ("organization") ("location")
+ ("month") ("addendum") ("pubstate")
+ ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
+ ("Thesis" "PhD or Master's Thesis"
(("author") ("title") ("type") ("institution")
("year" nil nil 0) ("date" nil nil 0))
nil
(("subtitle") ("titleaddon") ("language") ("note") ("location")
- ("month") ("isbn") ("chapter") ("pages") ("pagetotal")
+ ("month") ("isbn") ("eid") ("chapter") ("pages") ("pagetotal")
("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("Unpublished" "Unpublished"
(("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
nil
- (("subtitle") ("titleaddon") ("language") ("howpublished")
- ("note") ("location") ("isbn") ("date") ("month") ("year")
- ("addendum") ("pubstate") ("url") ("urldate"))))
+ (("subtitle") ("titleaddon") ("type") ("eventtitle") ("eventtitleaddon")
+ ("eventdate") ("venue") ("language") ("howpublished") ("note")
+ ("location") ("isbn") ("month") ("addendum") ("pubstate") ("doi")
+ ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))))
"Alist of biblatex entry types and their associated fields.
It has the same format as `bibtex-BibTeX-entry-alist'."
:group 'bibtex
- :version "24.1"
- :type 'bibtex-entry-alist)
-(put 'bibtex-biblatex-entry-alist 'risky-local-variable t)
+ :version "28.1"
+ :type 'bibtex-entry-alist
+ :risky t)
(define-widget 'bibtex-field-alist 'lazy
"Format of `bibtex-BibTeX-entry-alist' and friends."
@@ -770,6 +785,7 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD."
("eprinttype" "Type of eprint identifier")
("eventdate" "Date of a conference or some other event")
("eventtitle" "Title of a conference or some other event")
+ ("eventtitleaddon" "Annex to the eventtitle (e.g., acronym of known event)")
("file" "Local link to an electronic version of the work")
("foreword" "Author(s) of a foreword to the work")
("holder" "Holder(s) of a patent")
@@ -785,9 +801,11 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD."
("issue" "Issue of a journal")
("issuesubtitle" "Subtitle of a specific issue of a journal or other periodical.")
("issuetitle" "Title of a specific issue of a journal or other periodical.")
+ ("issuetitleaddon" "Annex to the issuetitle")
("iswc" "International Standard Work Code of a musical work")
("journalsubtitle" "Subtitle of a journal, a newspaper, or some other periodical.")
("journaltitle" "Name of a journal, a newspaper, or some other periodical.")
+ ("journaltitleaddon" "Annex to the journaltitle")
("label" "Substitute for the regular label to be used by the citation style")
("language" "Language(s) of the work")
("library" "Library name and a call number")
@@ -815,6 +833,8 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD."
("series" "Name of a publication series")
("shortauthor" "Author(s) of the work, given in an abbreviated form")
("shorteditor" "Editor(s) of the work, given in an abbreviated form")
+ ("shorthand" "Special designation overriding the default label")
+ ("shorthandintro" "Phrase overriding the standard shorthand introduction")
("shortjournal" "Short version or an acronym of the journal title")
("shortseries" "Short version or an acronym of the series field")
("shorttitle" "Title in an abridged form")
@@ -833,7 +853,7 @@ if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD."
"Alist of biblatex fields.
It has the same format as `bibtex-BibTeX-entry-alist'."
:group 'bibtex
- :version "24.1"
+ :version "28.1"
:type 'bibtex-field-alist)
(defcustom bibtex-dialect-list '(BibTeX biblatex)
@@ -850,15 +870,15 @@ Predefined dialects include BibTeX and biblatex."
To interactively change the dialect use the command `bibtex-set-dialect'."
:group 'bibtex
:version "24.1"
- :set '(lambda (symbol value)
- (set-default symbol value)
- ;; `bibtex-set-dialect' is undefined during loading (no problem)
- (if (fboundp 'bibtex-set-dialect)
- (bibtex-set-dialect value)))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ ;; `bibtex-set-dialect' is undefined during loading (no problem).
+ (if (fboundp 'bibtex-set-dialect)
+ (bibtex-set-dialect value)))
:type '(choice (const BibTeX)
(const biblatex)
- (symbol :tag "Custom")))
-(put 'bibtex-dialect 'safe-local-variable 'symbolp)
+ (symbol :tag "Custom"))
+ :safe #'symbolp)
(defcustom bibtex-no-opt-remove-re "\\`option"
"If a field name matches this regexp, the prefix OPT is not removed.
@@ -1051,7 +1071,7 @@ See `bibtex-generate-autokey' for details."
(defvaralias 'bibtex-autokey-name-case-convert
'bibtex-autokey-name-case-convert-function)
-(defcustom bibtex-autokey-name-case-convert-function 'downcase
+(defcustom bibtex-autokey-name-case-convert-function #'downcase
"Function called for each name to perform case conversion.
See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
@@ -1059,9 +1079,8 @@ See `bibtex-generate-autokey' for details."
(const :tag "Downcase" downcase)
(const :tag "Capitalize" capitalize)
(const :tag "Upcase" upcase)
- (function :tag "Conversion function")))
-(put 'bibtex-autokey-name-case-convert-function 'safe-local-variable
- (lambda (x) (memq x '(upcase downcase capitalize identity))))
+ (function :tag "Conversion function" :value identity))
+ :safe (lambda (x) (memq x '(upcase downcase capitalize identity))))
(defcustom bibtex-autokey-name-length 'infty
"Number of characters from name to incorporate into key.
@@ -1127,7 +1146,7 @@ Case is significant. See `bibtex-generate-autokey' for details."
(defvaralias 'bibtex-autokey-titleword-case-convert
'bibtex-autokey-titleword-case-convert-function)
-(defcustom bibtex-autokey-titleword-case-convert-function 'downcase
+(defcustom bibtex-autokey-titleword-case-convert-function #'downcase
"Function called for each titleword to perform case conversion.
See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
@@ -1188,12 +1207,13 @@ See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
:type 'boolean)
-(defcustom bibtex-autokey-before-presentation-function nil
- "If non-nil, function to call before generated key is presented.
+(defcustom bibtex-autokey-before-presentation-function #'identity
+ "Function to call before generated key is presented.
The function must take one argument (the automatically generated key),
and must return a string (the key to use)."
:group 'bibtex-autokey
- :type '(choice (const nil) function))
+ :version "28.1"
+ :type 'function)
(defcustom bibtex-entry-offset 0
"Offset for BibTeX entries.
@@ -1242,7 +1262,7 @@ If non-nil, the column for the equal sign is the value of
:group 'bibtex
:type '(repeat string))
-(defcustom bibtex-summary-function 'bibtex-summary
+(defcustom bibtex-summary-function #'bibtex-summary
"Function to call for generating a summary of current BibTeX entry.
It takes no arguments. Point must be at beginning of entry.
Used by `bibtex-complete-crossref-cleanup' and `bibtex-copy-summary-as-kill'."
@@ -1312,8 +1332,8 @@ The following is a complex example, see URL `http://link.aps.org/'.
(regexp :tag "Regexp")
(choice (string :tag "Replacement")
(integer :tag "Sub-match")
- (function :tag "Filter"))))))))
-(put 'bibtex-generate-url-list 'risky-local-variable t)
+ (function :tag "Filter")))))))
+ :risky t)
(defcustom bibtex-cite-matcher-alist
'(("\\\\cite[ \t\n]*{\\([^}]+\\)}" . 1))
@@ -1535,21 +1555,19 @@ At most `bibtex-entry-kill-ring-max' items are kept here.")
(defvar bibtex-last-kill-command nil
"Type of the last kill command (either `field' or `entry').")
-(defvar bibtex-strings
+(defvar-local bibtex-strings
(lazy-completion-table bibtex-strings
(lambda ()
(bibtex-parse-strings (bibtex-string-files-init))))
"Completion table for BibTeX string keys.
Initialized from `bibtex-predefined-strings' and `bibtex-string-files'.")
-(make-variable-buffer-local 'bibtex-strings)
(put 'bibtex-strings 'risky-local-variable t)
-(defvar bibtex-reference-keys
+(defvar-local bibtex-reference-keys
(lazy-completion-table bibtex-reference-keys
(lambda () (bibtex-parse-keys nil t)))
"Completion table for BibTeX reference keys.
The CDRs of the elements are t for header keys and nil for crossref keys.")
-(make-variable-buffer-local 'bibtex-reference-keys)
(put 'bibtex-reference-keys 'risky-local-variable t)
(defvar bibtex-buffer-last-parsed-tick nil
@@ -1660,7 +1678,7 @@ Initialized by `bibtex-set-dialect'.")
(defvar bibtex-font-lock-url-regexp
;; Assume that field names begin at the beginning of a line.
(concat "^[ \t]*"
- (regexp-opt (delete-dups (mapcar 'caar bibtex-generate-url-list)) t)
+ (regexp-opt (delete-dups (mapcar #'caar bibtex-generate-url-list)) t)
"[ \t]*=[ \t]*")
"Regexp for `bibtex-font-lock-url' derived from `bibtex-generate-url-list'.")
@@ -1892,14 +1910,16 @@ If `bibtex-expand-strings' is non-nil, also expand BibTeX strings."
(let ((mtch (match-string-no-properties 0)))
(push (or (if bibtex-expand-strings
(cdr (assoc-string mtch (bibtex-strings) t)))
- mtch) content)
+ mtch)
+ content)
(goto-char (match-end 0)))
(let ((bounds (bibtex-parse-field-string)))
(push (buffer-substring-no-properties
- (1+ (car bounds)) (1- (cdr bounds))) content)
+ (1+ (car bounds)) (1- (cdr bounds)))
+ content)
(goto-char (cdr bounds))))
(re-search-forward "\\=[ \t\n]*#[ \t\n]*" nil t))
- (apply 'concat (nreverse content))))
+ (apply #'concat (nreverse content))))
(buffer-substring-no-properties (bibtex-start-of-text-in-field bounds)
(bibtex-end-of-text-in-field bounds))))
@@ -2239,8 +2259,9 @@ Optional arg BEG is beginning of entry."
Optional arg COMMA is as in `bibtex-enclosing-field'."
(unless bibtex-last-kill-command (error "BibTeX kill ring is empty"))
(let ((fun (lambda (kryp kr) ; adapted from `current-kill'
- (car (set kryp (nthcdr (mod (- n (length (eval kryp)))
- (length kr)) kr))))))
+ (car (set kryp (nthcdr (mod (- n (length (symbol-value kryp)))
+ (length kr))
+ kr))))))
;; We put the mark at the beginning of the inserted field or entry
;; and point at its end - a behavior similar to what `yank' does.
;; The mark is then used by `bibtex-yank-pop', which needs to know
@@ -2251,7 +2272,8 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
(goto-char (bibtex-end-of-field (bibtex-enclosing-field comma)))
(push-mark)
(bibtex-make-field (funcall fun 'bibtex-field-kill-ring-yank-pointer
- bibtex-field-kill-ring) t nil t))
+ bibtex-field-kill-ring)
+ t nil t))
;; insert past the current entry
(bibtex-skip-to-valid-entry)
(push-mark)
@@ -2615,7 +2637,7 @@ Return optimized value to be used by `bibtex-format-entry'."
regexp-alist))
(let (opt-list)
;; Loop over field names
- (dolist (field (delete-dups (apply 'append (mapcar 'car regexp-alist))))
+ (dolist (field (delete-dups (apply #'append (mapcar #'car regexp-alist))))
(let (rules)
;; Collect all matches we have for this field name
(dolist (e regexp-alist)
@@ -2623,7 +2645,7 @@ Return optimized value to be used by `bibtex-format-entry'."
(push (cons (nth 1 e) (nth 2 e)) rules)))
(if (eq type 'braces)
;; concatenate all regexps to a single regexp
- (setq rules (concat "\\(?:" (mapconcat 'car rules "\\|") "\\)")))
+ (setq rules (concat "\\(?:" (mapconcat #'car rules "\\|") "\\)")))
;; create list of replacement rules.
(push (cons field rules) opt-list)))
opt-list))
@@ -2674,7 +2696,7 @@ and `bibtex-autokey-names-stretch'."
(if (string= "" names)
names
(let* ((case-fold-search t)
- (name-list (mapcar 'bibtex-autokey-demangle-name
+ (name-list (mapcar #'bibtex-autokey-demangle-name
(split-string names "[ \t\n]+and[ \t\n]+")))
additional-names)
(unless (or (not (numberp bibtex-autokey-names))
@@ -2686,7 +2708,7 @@ and `bibtex-autokey-names-stretch'."
bibtex-autokey-names)
(nreverse name-list)))
additional-names bibtex-autokey-additional-names))
- (concat (mapconcat 'identity name-list
+ (concat (mapconcat #'identity name-list
bibtex-autokey-name-separator)
additional-names)))))
@@ -2736,7 +2758,7 @@ Return the result as a string."
;; specific words and use only a specific amount of words.
(let ((counter 0)
(ignore-re (concat "\\`\\(?:"
- (mapconcat 'identity
+ (mapconcat #'identity
bibtex-autokey-titleword-ignore "\\|")
"\\)\\'"))
titlewords titlewords-extra word)
@@ -2760,7 +2782,7 @@ Return the result as a string."
;; titlewords-extra in titlewords. Otherwise, we ignore titlewords-extra.
(unless (string-match "\\b\\w+" titlestring)
(setq titlewords (append titlewords-extra titlewords)))
- (mapconcat 'bibtex-autokey-demangle-title (nreverse titlewords)
+ (mapconcat #'bibtex-autokey-demangle-title (nreverse titlewords)
bibtex-autokey-titleword-separator))))
(defun bibtex-autokey-demangle-title (titleword)
@@ -2837,7 +2859,7 @@ Concatenate the key:
non-empty insert `bibtex-autokey-name-year-separator' between the two.
If the title part and the year (or name) part are non-empty, insert
`bibtex-autokey-year-title-separator' between the two.
- 2. If `bibtex-autokey-before-presentation-function' is non-nil, it must be
+ 2. `bibtex-autokey-before-presentation-function' must be
a function taking one argument. Call this function with the generated
key as the argument. Use the return value of this function (a string)
as the key.
@@ -2865,7 +2887,7 @@ Concatenate the key:
(defun bibtex-global-key-alist ()
"Return global key alist based on `bibtex-files'."
(if bibtex-files
- (apply 'append
+ (apply #'append
(mapcar (lambda (buf)
(with-current-buffer buf bibtex-reference-keys))
;; include current buffer only if it uses `bibtex-mode'
@@ -3129,7 +3151,7 @@ does not use `bibtex-mode'."
(if buffer-list
(switch-to-buffer
(completing-read "Switch to BibTeX buffer: "
- (mapcar 'buffer-name buffer-list)
+ (mapcar #'buffer-name buffer-list)
nil t
(if current (buffer-name (current-buffer)))))
(message "No BibTeX buffers defined")))
@@ -3178,7 +3200,7 @@ that is generated by calling `bibtex-url'."
Used as default value of `bibtex-summary-function'."
;; It would be neat to make this function customizable. How?
(if (looking-at bibtex-entry-maybe-empty-head)
- (let* ((bibtex-autokey-name-case-convert-function 'identity)
+ (let* ((bibtex-autokey-name-case-convert-function #'identity)
(bibtex-autokey-name-length 'infty)
(bibtex-autokey-names 1)
(bibtex-autokey-names-stretch 0)
@@ -3189,7 +3211,7 @@ Used as default value of `bibtex-summary-function'."
(year (bibtex-autokey-get-year))
(bibtex-autokey-titlewords 5)
(bibtex-autokey-titlewords-stretch 2)
- (bibtex-autokey-titleword-case-convert-function 'identity)
+ (bibtex-autokey-titleword-case-convert-function #'identity)
(bibtex-autokey-titleword-length 5)
(bibtex-autokey-titleword-separator " ")
(title (bibtex-autokey-get-title))
@@ -3336,12 +3358,12 @@ BOUND limits the search."
(define-button-type 'bibtex-url
'action 'bibtex-button-action
- 'bibtex-function 'bibtex-url
+ 'bibtex-function #'bibtex-url
'help-echo (purecopy "mouse-2, RET: follow URL"))
(define-button-type 'bibtex-search-crossref
'action 'bibtex-button-action
- 'bibtex-function 'bibtex-search-crossref
+ 'bibtex-function #'bibtex-search-crossref
'help-echo (purecopy "mouse-2, RET: follow crossref"))
(defun bibtex-button (beg end type &rest args)
@@ -3405,7 +3427,7 @@ if that value is non-nil.
\\{bibtex-mode-map}"
(add-hook 'completion-at-point-functions
- 'bibtex-completion-at-point-function nil 'local)
+ #'bibtex-completion-at-point-function nil 'local)
(make-local-variable 'bibtex-buffer-last-parsed-tick)
;; Install stealthy parse function if not already installed
(unless bibtex-parse-idle-timer
@@ -3419,7 +3441,7 @@ if that value is non-nil.
(set (make-local-variable 'comment-column) 0)
(set (make-local-variable 'defun-prompt-regexp) "^[ \t]*@[[:alnum:]]+[ \t]*")
(set (make-local-variable 'outline-regexp) "[ \t]*@")
- (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field)
+ (set (make-local-variable 'fill-paragraph-function) #'bibtex-fill-field)
(set (make-local-variable 'fill-prefix)
(make-string (+ bibtex-entry-offset bibtex-contline-indentation) ?\s))
(set (make-local-variable 'font-lock-defaults)
@@ -3440,8 +3462,9 @@ if that value is non-nil.
(set (make-local-variable 'syntax-propertize-function)
(syntax-propertize-via-font-lock
bibtex-font-lock-syntactic-keywords))
+ (bibtex-set-dialect nil t)
;; Allow `bibtex-dialect' as a file-local variable.
- (add-hook 'hack-local-variables-hook 'bibtex-set-dialect nil t))
+ (add-hook 'hack-local-variables-hook #'bibtex-set-dialect nil t))
(defun bibtex-entry-alist (dialect)
"Return entry-alist for DIALECT."
@@ -3488,8 +3511,9 @@ are also bound buffer-locally if `bibtex-dialect' is already buffer-local
in the current buffer (for example, as a file-local variable).
LOCAL is t for interactive calls."
(interactive (list (intern (completing-read "Dialect: "
- (mapcar 'list bibtex-dialect-list)
- nil t)) t))
+ (mapcar #'list bibtex-dialect-list)
+ nil t))
+ t))
(let ((setfun (if (or local (local-variable-p 'bibtex-dialect))
(lambda (var val) (set (make-local-variable var) val))
'set)))
@@ -3506,7 +3530,7 @@ LOCAL is t for interactive calls."
bibtex-dialect))))
(funcall setfun 'bibtex-entry-type
(concat "@[ \t]*\\(?:"
- (regexp-opt (mapcar 'car bibtex-entry-alist)) "\\)"))
+ (regexp-opt (mapcar #'car bibtex-entry-alist)) "\\)"))
(funcall setfun 'bibtex-entry-head
(concat "^[ \t]*\\(" bibtex-entry-type "\\)[ \t]*[({][ \t\n]*\\("
bibtex-reference-key "\\)"))
@@ -3516,7 +3540,7 @@ LOCAL is t for interactive calls."
(concat "^[ \t]*@[ \t]*\\(?:"
(regexp-opt
(append '("String" "Preamble")
- (mapcar 'car bibtex-entry-alist))) "\\)"))
+ (mapcar #'car bibtex-entry-alist))) "\\)"))
(setq imenu-generic-expression
(list (list nil bibtex-entry-head bibtex-key-in-head))
imenu-case-fold-search t)))
@@ -3549,11 +3573,13 @@ LOCAL is t for interactive calls."
(let* ((entry (car elt))
(fname (intern (format "bibtex-%s" entry))))
(unless (fboundp fname)
- (eval (list 'defun fname nil
- (format "Insert a template for a @%s entry; see also `bibtex-entry'."
- entry)
- '(interactive "*")
- `(bibtex-entry ,entry))))
+ (defalias fname
+ (lambda ()
+ (:documentation
+ (format "Insert a template for a @%s entry; see also `bibtex-entry'."
+ entry))
+ (interactive "*")
+ (bibtex-entry entry))))
;; Menu entries
(define-key menu-map (vector fname)
`(menu-item ,(or (nth 1 elt) (car elt)) ,fname))))
@@ -3608,8 +3634,8 @@ is non-nil."
(insert "@" entry-type (bibtex-entry-left-delimiter))
(if key (insert key))
(save-excursion
- (mapc 'bibtex-make-field (car field-list))
- (mapc 'bibtex-make-optional-field (cdr field-list))
+ (mapc #'bibtex-make-field (car field-list))
+ (mapc #'bibtex-make-optional-field (cdr field-list))
(if bibtex-comma-after-last-field
(insert ","))
(insert "\n")
@@ -3657,8 +3683,8 @@ When called interactively with a prefix arg, query for a value of ENTRY-TYPE."
(insert (bibtex-field-left-delimiter)))
(goto-char end)))
(skip-chars-backward " \t\n")
- (mapc 'bibtex-make-field required)
- (mapc 'bibtex-make-optional-field optional)))))
+ (mapc #'bibtex-make-field required)
+ (mapc #'bibtex-make-optional-field optional)))))
(defun bibtex-parse-entry (&optional content keep-opt-alt)
"Parse entry at point, return an alist.
@@ -4980,7 +5006,8 @@ If mark is active reformat entries in region, if not in whole buffer."
("Remove empty optional and alternative fields? " . opts-or-alts)
("Remove delimiters around pure numerical fields? " . numerical-fields)
(,(concat (if bibtex-comma-after-last-field "Insert" "Remove")
- " comma at end of entry? ") . last-comma)
+ " comma at end of entry? ")
+ . last-comma)
("Replace double page dashes by single ones? " . page-dashes)
("Delete whitespace at the beginning and end of fields? " . whitespace)
("Inherit booktitle? " . inherit-booktitle)
@@ -5047,7 +5074,7 @@ entries from minibuffer."
(goto-char (point-max))
(message "Buffer is now parsable. Please save it.")))
-(define-obsolete-function-alias 'bibtex-complete 'completion-at-point "24.1")
+(define-obsolete-function-alias 'bibtex-complete #'completion-at-point "24.1")
(defun bibtex-completion-at-point-function ()
(let ((pnt (point))
(case-fold-search t)
@@ -5258,8 +5285,8 @@ Return the URL or nil if none can be generated."
;; If SCHEME is set up correctly,
;; we should never reach this point
(error "Match failed: %s" text)))
- (if fmt (apply 'format fmt (nreverse obj))
- (apply 'concat (nreverse obj)))))
+ (if fmt (apply #'format fmt (nreverse obj))
+ (apply #'concat (nreverse obj)))))
(if (called-interactively-p 'interactive) (message "%s" url))
(unless no-browse (browse-url url)))
(if (and (not url) (called-interactively-p 'interactive))
@@ -5289,10 +5316,11 @@ where FILE is the BibTeX file of ENTRY."
(list (completing-read
"Field: "
(delete-dups
- (apply 'append
+ (apply #'append
bibtex-user-optional-fields
- (mapcar (lambda (x) (mapcar 'car (apply 'append (nthcdr 2 x))))
- bibtex-entry-alist))) nil t)
+ (mapcar (lambda (x) (mapcar #'car (apply #'append (nthcdr 2 x))))
+ bibtex-entry-alist)))
+ nil t)
(read-string "Regexp: ")
(if bibtex-search-entry-globally
(not current-prefix-arg)
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index 86db6980433..722fc0a3137 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -44,28 +44,23 @@
"Align assignments to this column by default with \\[conf-align-assignments].
If this number is negative, the `=' comes before the whitespace. Use 0 to
not align (only setting space according to `conf-assignment-space')."
- :type 'integer
- :group 'conf)
+ :type 'integer)
(defcustom conf-javaprop-assignment-column 32
"Value for `conf-assignment-column' in Java properties buffers."
- :type 'integer
- :group 'conf)
+ :type 'integer)
(defcustom conf-colon-assignment-column (- (abs conf-assignment-column))
"Value for `conf-assignment-column' in Java properties buffers."
- :type 'integer
- :group 'conf)
+ :type 'integer)
(defcustom conf-assignment-space t
"Put at least one space around assignments when aligning."
- :type 'boolean
- :group 'conf)
+ :type 'boolean)
(defcustom conf-colon-assignment-space nil
"Value for `conf-assignment-space' in colon style Conf mode buffers."
- :type 'boolean
- :group 'conf)
+ :type 'boolean)
(defvar conf-mode-map
(let ((map (make-sparse-keymap))
@@ -349,9 +344,37 @@ unbalanced, but hey...)"
(scan-error depth))))
+(defun conf--guess-mode ()
+ "Try to guess sub-mode of `conf-mode' based on buffer content."
+ (let ((unix 0) (win 0) (equal 0) (colon 0) (space 0) (jp 0))
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward " \t\f")
+ (cond ((eq (char-after) ?\#) (setq unix (1+ unix)))
+ ((eq (char-after) ?\;) (setq win (1+ win)))
+ ((eq (char-after) ?\[)) ; nop
+ ((eolp)) ; nop
+ ((eq (char-after) ?})) ; nop
+ ;; recognize at most double spaces within names
+ ((looking-at "[^ \t\n=:]+\\(?: ?[^ \t\n=:]+\\)*[ \t]*[=:]")
+ (if (eq (char-before (match-end 0)) ?=)
+ (setq equal (1+ equal))
+ (setq colon (1+ colon))))
+ ((looking-at "/[/*]") (setq jp (1+ jp)))
+ ((looking-at ".*{")) ; nop
+ ((setq space (1+ space))))
+ (forward-line)))
+ (cond
+ ((> jp (max unix win 3)) #'conf-javaprop-mode)
+ ((> colon (max equal space)) #'conf-colon-mode)
+ ((> space (max equal colon)) #'conf-space-mode)
+ ((or (> win unix) (and (= win unix) (eq system-type 'windows-nt)))
+ #'conf-windows-mode)
+ (t #'conf-unix-mode))))
;;;###autoload
-(defun conf-mode ()
+(define-derived-mode conf-mode nil "Conf[?]"
"Mode for Unix and Windows Conf files and Java properties.
Most conf files know only three kinds of constructs: parameter
assignments optionally grouped into sections and comments. Yet
@@ -382,75 +405,41 @@ See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode',
\\{conf-mode-map}"
- (interactive)
- ;; `conf-mode' plays two roles: it's the parent of several sub-modes
- ;; but it's also the function that chooses between those submodes.
- ;; To tell the difference between those two cases where the function
- ;; might be called, we check `delay-mode-hooks'.
- ;; (adopted from tex-mode.el)
- (if (not delay-mode-hooks)
- ;; try to guess sub-mode of conf-mode based on buffer content
- (let ((unix 0) (win 0) (equal 0) (colon 0) (space 0) (jp 0))
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\f")
- (cond ((eq (char-after) ?\#) (setq unix (1+ unix)))
- ((eq (char-after) ?\;) (setq win (1+ win)))
- ((eq (char-after) ?\[)) ; nop
- ((eolp)) ; nop
- ((eq (char-after) ?})) ; nop
- ;; recognize at most double spaces within names
- ((looking-at "[^ \t\n=:]+\\(?: ?[^ \t\n=:]+\\)*[ \t]*[=:]")
- (if (eq (char-before (match-end 0)) ?=)
- (setq equal (1+ equal))
- (setq colon (1+ colon))))
- ((looking-at "/[/*]") (setq jp (1+ jp)))
- ((looking-at ".*{")) ; nop
- ((setq space (1+ space))))
- (forward-line)))
- (cond
- ((> jp (max unix win 3)) (conf-javaprop-mode))
- ((> colon (max equal space)) (conf-colon-mode))
- ((> space (max equal colon)) (conf-space-mode))
- ((or (> win unix) (and (= win unix) (eq system-type 'windows-nt)))
- (conf-windows-mode))
- (t (conf-unix-mode))))
-
- (kill-all-local-variables)
- (use-local-map conf-mode-map)
- (setq major-mode 'conf-mode
- mode-name "Conf[?]")
- (set (make-local-variable 'font-lock-defaults)
- '(conf-font-lock-keywords nil t nil nil))
- ;; Let newcomment.el decide this for itself.
- ;; (set (make-local-variable 'comment-use-syntax) t)
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'outline-regexp)
- "[ \t]*\\(?:\\[\\|.+[ \t\n]*{\\)")
- (set (make-local-variable 'outline-heading-end-regexp)
- "[\n}]")
- (set (make-local-variable 'outline-level)
- 'conf-outline-level)
- (set-syntax-table conf-mode-syntax-table)
- (setq imenu-generic-expression
- '(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*=" 1)
- ;; [section]
- (nil "^[ \t]*\\[[ \t]*\\(.+\\)[ \t]*\\]" 1)
- ;; section { ... }
- (nil "^[ \t]*\\([^=:{} \t\n][^=:{}\n]+\\)[ \t\n]*{" 1)))
- (run-mode-hooks 'conf-mode-hook)))
+ (setq-local font-lock-defaults '(conf-font-lock-keywords nil t nil nil))
+ ;; Let newcomment.el decide this for itself.
+ ;; (setq-local comment-use-syntax t)
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local outline-regexp "[ \t]*\\(?:\\[\\|.+[ \t\n]*{\\)")
+ (setq-local outline-heading-end-regexp "[\n}]")
+ (setq-local outline-level #'conf-outline-level)
+ (setq-local imenu-generic-expression
+ '(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*=" 1)
+ ;; [section]
+ (nil "^[ \t]*\\[[ \t]*\\(.+\\)[ \t]*\\]" 1)
+ ;; section { ... }
+ (nil "^[ \t]*\\([^=:{} \t\n][^=:{}\n]+\\)[ \t\n]*{" 1))))
+
+;; `conf-mode' plays two roles: it's the parent of several sub-modes
+;; but it's also the function that chooses between those submodes.
+;; To tell the difference between those two cases where the function
+;; might be called, we check `delay-mode-hooks'.
+;; (inspired from tex-mode.el)
+(advice-add 'conf-mode :around
+ (lambda (orig-fun)
+ "Redirect to one of the submodes when called directly."
+ (funcall (if delay-mode-hooks orig-fun (conf--guess-mode)))))
+
+
(defun conf-mode-initialize (comment &optional font-lock)
"Initializations for sub-modes of `conf-mode'.
COMMENT initializes `comment-start' and `comment-start-skip'.
The optional arg FONT-LOCK is the value for FONT-LOCK-KEYWORDS."
- (set (make-local-variable 'comment-start) comment)
- (set (make-local-variable 'comment-start-skip)
- (concat (regexp-quote comment-start) "+\\s *"))
+ (setq-local comment-start comment)
+ (setq-local comment-start-skip
+ (concat (regexp-quote comment-start) "+\\s *"))
(if font-lock
- (set (make-local-variable 'font-lock-defaults)
- `(,font-lock nil t nil nil))))
+ (setq-local font-lock-defaults `(,font-lock nil t nil nil))))
;;;###autoload
(define-derived-mode conf-unix-mode conf-mode "Conf[Unix]"
@@ -497,13 +486,11 @@ x.1 =
x.2.y.1.z.1 =
x.2.y.1.z.2.zz ="
(conf-mode-initialize "#" 'conf-javaprop-font-lock-keywords)
- (set (make-local-variable 'conf-assignment-column)
- conf-javaprop-assignment-column)
- (set (make-local-variable 'conf-assignment-regexp)
- ".+?\\([ \t]*[=: \t][ \t]*\\|$\\)")
- (setq comment-start-skip "\\(?:#+\\|/[/*]+\\)\\s *")
- (setq imenu-generic-expression
- '(("Parameters" "^[ \t]*\\(.+?\\)[=: \t]" 1))))
+ (setq-local conf-assignment-column conf-javaprop-assignment-column)
+ (setq-local conf-assignment-regexp ".+?\\([ \t]*[=: \t][ \t]*\\|$\\)")
+ (setq-local comment-start-skip "\\(?:#+\\|/[/*]+\\)\\s *")
+ (setq-local imenu-generic-expression
+ '(("Parameters" "^[ \t]*\\(.+?\\)[=: \t]" 1))))
;;;###autoload
(define-derived-mode conf-space-mode conf-unix-mode "Conf[Space]"
@@ -529,20 +516,18 @@ class desktop
add /dev/audio desktop
add /dev/mixer desktop"
(conf-mode-initialize "#" 'conf-space-font-lock-keywords)
- (make-local-variable 'conf-assignment-sign)
- (setq conf-assignment-sign nil)
- (make-local-variable 'conf-space-keywords)
+ (setq-local conf-assignment-sign nil)
(cond (buffer-file-name
;; We set conf-space-keywords directly, but a value which is
;; in the local variables list or interactively specified
;; (see the function conf-space-keywords) takes precedence.
- (setq conf-space-keywords
- (assoc-default buffer-file-name conf-space-keywords-alist
- 'string-match))))
+ (setq-local conf-space-keywords
+ (assoc-default buffer-file-name conf-space-keywords-alist
+ #'string-match))))
(conf-space-mode-internal)
;; In case the local variables list specifies conf-space-keywords,
;; recompute other things from that afterward.
- (add-hook 'hack-local-variables-hook 'conf-space-mode-internal nil t))
+ (add-hook 'hack-local-variables-hook #'conf-space-mode-internal nil t))
;;;###autoload
(defun conf-space-keywords (keywords)
@@ -553,16 +538,16 @@ See `conf-space-mode'."
(conf-space-mode))
(if (string-equal keywords "")
(setq keywords nil))
- (setq conf-space-keywords keywords)
+ (setq-local conf-space-keywords keywords)
(conf-space-mode-internal)
(run-mode-hooks))
(defun conf-space-mode-internal ()
- (make-local-variable 'conf-assignment-regexp)
- (setq conf-assignment-regexp
- (if conf-space-keywords
- (concat "\\(?:" conf-space-keywords "\\)[ \t]+.+?\\([ \t]+\\|$\\)")
- ".+?\\([ \t]+\\|$\\)"))
+ (setq-local conf-assignment-regexp
+ (if conf-space-keywords
+ (concat "\\(?:" conf-space-keywords
+ "\\)[ \t]+.+?\\([ \t]+\\|$\\)")
+ ".+?\\([ \t]+\\|$\\)"))
;; If Font Lock is already enabled, reenable it with new
;; conf-assignment-regexp.
(when (and font-lock-mode
@@ -596,17 +581,13 @@ For details see `conf-mode'. Example:
<Multi_key> <exclam> <exclam> : \"\\241\" exclamdown
<Multi_key> <c> <slash> : \"\\242\" cent"
(conf-mode-initialize "#" 'conf-colon-font-lock-keywords)
- (set (make-local-variable 'conf-assignment-space)
- conf-colon-assignment-space)
- (set (make-local-variable 'conf-assignment-column)
- conf-colon-assignment-column)
- (set (make-local-variable 'conf-assignment-sign)
- ?:)
- (set (make-local-variable 'conf-assignment-regexp)
- ".+?\\([ \t]*:[ \t]*\\)")
- (setq imenu-generic-expression
- `(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*:" 1)
- ,@(cdr imenu-generic-expression))))
+ (setq-local conf-assignment-space conf-colon-assignment-space)
+ (setq-local conf-assignment-column conf-colon-assignment-column)
+ (setq-local conf-assignment-sign ?:)
+ (setq-local conf-assignment-regexp ".+?\\([ \t]*:[ \t]*\\)")
+ (setq-local imenu-generic-expression
+ `(("Parameters" "^[ \t]*\\(.+?\\)[ \t]*:" 1)
+ ,@(cdr imenu-generic-expression))))
;;;###autoload
(define-derived-mode conf-ppd-mode conf-colon-mode "Conf[PPD]"
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 0d4a910a1db..747657b1ed5 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -67,7 +67,7 @@
(defconst scss-at-ids
'("at-root" "content" "debug" "each" "else" "else if" "error" "extend"
- "for" "function" "if" "import" "include" "mixin" "return" "warn"
+ "for" "function" "if" "import" "include" "mixin" "return" "use" "warn"
"while")
"Additional identifiers that appear in the form @foo in SCSS.")
@@ -100,7 +100,7 @@
"Identifiers for types of media.")
(defconst css-property-alist
- ;; CSS 2.1 properties (http://www.w3.org/TR/CSS21/propidx.html).
+ ;; CSS 2.1 properties (https://www.w3.org/TR/CSS21/propidx.html).
;;
;; Properties duplicated by any of the CSS3 modules below have been
;; removed.
@@ -119,7 +119,6 @@
("cue" cue-before cue-after)
("cue-after" uri "none")
("cue-before" uri "none")
- ("direction" "ltr" "rtl")
("display" "inline" "block" "list-item" "inline-block" "table"
"inline-table" "table-row-group" "table-header-group"
"table-footer-group" "table-row" "table-column-group"
@@ -180,7 +179,6 @@
("stress" number)
("table-layout" "auto" "fixed")
("top" length percentage "auto")
- ("unicode-bidi" "normal" "embed" "bidi-override")
("vertical-align" "baseline" "sub" "super" "top" "text-top"
"middle" "bottom" "text-bottom" percentage length)
("visibility" "visible" "hidden" "collapse")
@@ -192,7 +190,7 @@
("z-index" "auto" integer)
;; CSS Animations
- ;; (http://www.w3.org/TR/css3-animations/#property-index)
+ ;; (https://www.w3.org/TR/css3-animations/#property-index)
("animation" single-animation-name time single-timing-function
single-animation-iteration-count single-animation-direction
single-animation-fill-mode single-animation-play-state)
@@ -206,7 +204,7 @@
("animation-timing-function" single-timing-function)
;; CSS Backgrounds and Borders Module Level 3
- ;; (http://www.w3.org/TR/css3-background/#property-index)
+ ;; (https://www.w3.org/TR/css3-background/#property-index)
("background" bg-layer final-bg-layer)
("background-attachment" attachment)
("background-clip" box)
@@ -251,7 +249,7 @@
("box-shadow" "none" shadow)
;; CSS Basic User Interface Module Level 3 (CSS3 UI)
- ;; (http://www.w3.org/TR/css3-ui/#property-index)
+ ;; (https://www.w3.org/TR/css3-ui/#property-index)
("box-sizing" "content-box" "border-box")
("caret-color" "auto" color)
("cursor" uri x y "auto" "default" "none" "context-menu" "help"
@@ -274,10 +272,14 @@
("text-overflow" "clip" "ellipsis" string)
;; CSS Color Module Level 3
- ;; (http://www.w3.org/TR/css3-color/#property)
+ ;; (https://www.w3.org/TR/css3-color/#property)
("color" color)
("opacity" alphavalue)
+ ;; CSS Containment Module Level 1
+ ;; (https://www.w3.org/TR/css-contain-1/#property-index)
+ ("contain" "none" "strict" "content" "size" "layout" "paint")
+
;; CSS Grid Layout Module Level 1
;; (https://www.w3.org/TR/css-grid-1/#property-index)
("grid" grid-template grid-template-rows "auto-flow" "dense"
@@ -302,7 +304,7 @@
("grid-template-rows" "none" track-list auto-track-list)
;; CSS Flexible Box Layout Module Level 1
- ;; (http://www.w3.org/TR/css-flexbox-1/#property-index)
+ ;; (https://www.w3.org/TR/css-flexbox-1/#property-index)
("align-content" "flex-start" "flex-end" "center" "space-between"
"space-around" "stretch")
("align-items" "flex-start" "flex-end" "center" "baseline"
@@ -321,7 +323,7 @@
("order" integer)
;; CSS Fonts Module Level 3
- ;; (http://www.w3.org/TR/css3-fonts/#property-index)
+ ;; (https://www.w3.org/TR/css3-fonts/#property-index)
("font" font-style font-variant-css21 font-weight font-stretch
font-size line-height font-family "caption" "icon" "menu"
"message-box" "small-caption" "status-bar")
@@ -417,7 +419,7 @@
("columns" column-width column-count)
;; CSS Overflow Module Level 3
- ;; (http://www.w3.org/TR/css-overflow-3/#property-index)
+ ;; (https://www.w3.org/TR/css-overflow-3/#property-index)
("max-lines" "none" integer)
("overflow" "visible" "hidden" "scroll" "auto" "paged-x" "paged-y"
"paged-x-controls" "paged-y-controls" "fragments")
@@ -446,7 +448,7 @@
("text-underline-position" "auto" "under" "left" "right")
;; CSS Text Module Level 3
- ;; (http://www.w3.org/TR/css3-text/#property-index)
+ ;; (https://www.w3.org/TR/css3-text/#property-index)
("hanging-punctuation" "none" "first" "force-end" "allow-end"
"last")
("hyphens" "none" "manual" "auto")
@@ -468,7 +470,7 @@
("word-wrap" "normal" "break-word")
;; CSS Transforms Module Level 1
- ;; (http://www.w3.org/TR/css3-2d-transforms/#property-index)
+ ;; (https://www.w3.org/TR/css3-2d-transforms/#property-index)
("backface-visibility" "visible" "hidden")
("perspective" "none" length)
("perspective-origin" "left" "center" "right" "top" "bottom"
@@ -479,7 +481,7 @@
("transform-style" "flat" "preserve-3d")
;; CSS Transitions
- ;; (http://www.w3.org/TR/css3-transitions/#property-index)
+ ;; (https://www.w3.org/TR/css3-transitions/#property-index)
("transition" single-transition)
("transition-delay" time)
("transition-duration" time)
@@ -490,8 +492,18 @@
;; (https://www.w3.org/TR/css-will-change-1/#property-index)
("will-change" "auto" animateable-feature)
+ ;; CSS Writing Modes Level 3
+ ;; (https://www.w3.org/TR/css-writing-modes-3/#property-index)
+ ;; "glyph-orientation-vertical" is obsolete and left out.
+ ("direction" "ltr" "rtl")
+ ("text-combine-upright" "none" "all")
+ ("text-orientation" "mixed" "upright" "sideways")
+ ("unicode-bidi" "normal" "embed" "isolate" "bidi-override"
+ "isolate-override" "plaintext")
+ ("writing-mode" "horizontal-tb" "vertical-rl" "vertical-lr")
+
;; Filter Effects Module Level 1
- ;; (http://www.w3.org/TR/filter-effects/#property-index)
+ ;; (https://www.w3.org/TR/filter-effects/#property-index)
("color-interpolation-filters" "auto" "sRGB" "linearRGB")
("filter" "none" filter-function-list)
("flood-color" color)
@@ -874,7 +886,7 @@ cannot be completed sensibly: `custom-ident',
(defconst css-escapes-re
"\\\\\\(?:[^\000-\037\177]\\|[[:xdigit:]]+[ \n\t\r\f]?\\)")
-(defconst css-nmchar-re (concat "\\(?:[-[:alnum:]]\\|" css-escapes-re "\\)"))
+(defconst css-nmchar-re (concat "\\(?:[-_[:alnum:]]\\|" css-escapes-re "\\)"))
(defconst css-nmstart-re (concat "\\(?:[[:alpha:]]\\|" css-escapes-re "\\)"))
(defconst css-ident-re ;; (concat css-nmstart-re css-nmchar-re "*")
;; Apparently, "at rules" names can start with a dash, e.g. @-moz-keyframes.
@@ -1137,17 +1149,6 @@ returns, point will be at the end of the recognized color."
;; Evaluate to the color if the name is found.
((css--named-color start-point match))))
-(defun css--contrasty-color (name)
- "Return a color that contrasts with NAME.
-NAME is of any form accepted by `color-distance'.
-The returned color will be usable by Emacs and will contrast
-with NAME; in particular so that if NAME is used as a background
-color, the returned color can be used as the foreground and still
-be readable."
- ;; See bug#25525 for a discussion of this.
- (if (> (color-distance name "black") 292485)
- "black" "white"))
-
(defcustom css-fontify-colors t
"Whether CSS colors should be fontified using the color as the background.
When non-`nil', a text representing CSS color will be fontified
@@ -1187,7 +1188,8 @@ START and END are buffer positions."
(add-text-properties
start (point)
(list 'face (list :background color
- :foreground (css--contrasty-color color)
+ :foreground (readable-foreground-color
+ color)
:box '(:line-width -1))))))))))))
extended-region))
@@ -1354,21 +1356,19 @@ the string PROPERTY."
(defun css--complete-property-value ()
"Complete property value at point."
- (let ((property
- (save-excursion
- (re-search-backward ":[^/]" (line-beginning-position) t)
- (when (eq (char-after) ?:)
- (let ((property-end (point)))
- (skip-chars-backward "-[:alnum:]")
- (let ((prop (buffer-substring (point) property-end)))
- (car (member prop css-property-ids))))))))
+ (let ((property (and (looking-back "\\([[:alnum:]-]+\\):[^/][^;]*"
+ (or (ppss-innermost-start (syntax-ppss))
+ (point))
+ t)
+ (member (match-string-no-properties 1)
+ css-property-ids))))
(when property
(let ((end (point)))
(save-excursion
(skip-chars-backward "[:graph:]")
(list (point) end
(append '("inherit" "initial" "unset")
- (css--property-values property))))))))
+ (css--property-values (car property)))))))))
(defvar css--html-tags (mapcar #'car html-tag-alist)
"List of HTML tags.
@@ -1881,12 +1881,9 @@ on what is seen near point."
(list
(let* ((sym (css--mdn-find-symbol))
(enable-recursive-minibuffers t)
- (value (completing-read
- (if sym
- (format "Describe CSS symbol (default %s): " sym)
- "Describe CSS symbol: ")
- css--mdn-completion-list nil nil nil
- 'css--mdn-lookup-history sym)))
+ (value (completing-read (format-prompt "Describe CSS symbol" sym)
+ css--mdn-completion-list nil nil nil
+ 'css--mdn-lookup-history sym)))
(if (equal value "") sym value))))
(when symbol
;; If we see a single-colon pseudo-element like ":after", turn it
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 4c24e70d1f7..2757074f9f8 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -57,7 +57,6 @@
(defcustom flyspell-highlight-flag t
"How Flyspell should indicate misspelled words.
Non-nil means use highlight, nil means use minibuffer messages."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-mark-duplications-flag t
@@ -65,12 +64,10 @@ Non-nil means use highlight, nil means use minibuffer messages."
See `flyspell-mark-duplications-exceptions' to add exceptions to this rule.
Detection of repeated words is not implemented in
\"large\" regions; see variable `flyspell-large-region'."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-case-fold-duplications t
"Non-nil means Flyspell matches duplicate words case-insensitively."
- :group 'flyspell
:type 'boolean
:version "27.1")
@@ -87,9 +84,8 @@ dictionary name (`ispell-local-dictionary' or
EXCEPTION-LIST is a list of strings. The checked word is
downcased before comparing with these exceptions."
- :group 'flyspell
:type '(alist :key-type (choice (const :tag "All dictionaries" nil)
- string)
+ regexp)
:value-type (repeat string))
:version "24.1")
@@ -97,7 +93,6 @@ downcased before comparing with these exceptions."
"If non-nil, sort the corrections before popping them.
The sorting is controlled by the `flyspell-sort-corrections-function'
variable, and defaults to sorting alphabetically."
- :group 'flyspell
:version "21.1"
:type 'boolean)
@@ -109,8 +104,7 @@ function takes three parameters -- the two correction candidates
to be sorted, and the third parameter is the word that's being
corrected."
:version "26.1"
- :type 'function
- :group 'flyspell)
+ :type 'function)
(defun flyspell-sort-corrections-alphabetically (corr1 corr2 _)
(string< corr1 corr2))
@@ -130,14 +124,12 @@ Flyspell uses a different face (`flyspell-duplicate') to highlight it.
This variable specifies how far to search to find such a duplicate.
-1 means no limit (search the whole buffer).
0 means do not search for duplicate unrecognized spellings."
- :group 'flyspell
:version "24.5" ; -1 -> 400000
:type '(choice (const :tag "no limit" -1)
number))
(defcustom flyspell-delay 3
"The number of seconds to wait before checking, after a \"delayed\" command."
- :group 'flyspell
:type 'number)
(defcustom flyspell-persistent-highlight t
@@ -147,12 +139,10 @@ is highlighted, and the highlight is turned off as soon as point moves
off the misspelled word.
Make sure this variable is non-nil if you use `flyspell-region'."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-highlight-properties t
"Non-nil means highlight incorrect words even if a property exists for this word."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-default-delayed-commands
@@ -164,7 +154,6 @@ Make sure this variable is non-nil if you use `flyspell-region'."
backward-delete-char-untabify)
"The standard list of delayed commands for Flyspell.
See `flyspell-delayed-commands'."
- :group 'flyspell
:version "21.1"
:type '(repeat (symbol)))
@@ -172,7 +161,6 @@ See `flyspell-delayed-commands'."
"List of commands that are \"delayed\" for Flyspell mode.
After these commands, Flyspell checking is delayed for a short time,
whose length is specified by `flyspell-delay'."
- :group 'flyspell
:type '(repeat (symbol)))
(defcustom flyspell-default-deplacement-commands
@@ -182,7 +170,6 @@ whose length is specified by `flyspell-delay'."
scroll-down)
"The standard list of deplacement commands for Flyspell.
See variable `flyspell-deplacement-commands'."
- :group 'flyspell
:version "21.1"
:type '(repeat (symbol)))
@@ -190,18 +177,15 @@ See variable `flyspell-deplacement-commands'."
"List of commands that are \"deplacement\" for Flyspell mode.
After these commands, Flyspell checking is performed only if the previous
command was not the very same command."
- :group 'flyspell
:version "21.1"
:type '(repeat (symbol)))
(defcustom flyspell-issue-welcome-flag t
"Non-nil means that Flyspell should display a welcome message when started."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-issue-message-flag t
"Non-nil means that Flyspell emits messages when checking words."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-incorrect-hook nil
@@ -213,7 +197,6 @@ of possible corrections as returned by `ispell-parse-output'.
If any of the functions return non-nil, the word is not highlighted as
incorrect."
- :group 'flyspell
:version "21.1"
:type 'hook)
@@ -225,50 +208,43 @@ when flyspell is started, the value of that variable is used instead
of `flyspell-default-dictionary' to select the default dictionary.
Otherwise, if `flyspell-default-dictionary' is nil, it means to use
Ispell's ultimate default dictionary."
- :group 'flyspell
:version "21.1"
:type '(choice string (const :tag "Default" nil)))
(defcustom flyspell-tex-command-regexp
"\\(\\(begin\\|end\\)[ \t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[ \t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)"
"A string that is the regular expression that matches TeX commands."
- :group 'flyspell
:version "21.1"
- :type 'string)
+ :type 'regexp)
(defcustom flyspell-check-tex-math-command nil
"Non-nil means check even inside TeX math environment.
TeX math environments are discovered by `texmathp', implemented
inside AUCTeX package. That package may be found at
URL `https://www.gnu.org/software/auctex/'"
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter
'("francais" "deutsch8" "norsk")
"List of dictionary names that consider `-' as word delimiter."
- :group 'flyspell
:version "21.1"
:type '(repeat (string)))
(defcustom flyspell-abbrev-p
nil
"If non-nil, add correction to abbreviation table."
- :group 'flyspell
:version "21.1"
:type 'boolean)
(defcustom flyspell-use-global-abbrev-table-p
nil
"If non-nil, prefer global abbrev table to local abbrev table."
- :group 'flyspell
:version "21.1"
:type 'boolean)
(defcustom flyspell-mode-line-string " Fly"
"String displayed on the mode line when flyspell is active.
Set this to nil if you don't want a mode line indicator."
- :group 'flyspell
:type '(choice string (const :tag "None" nil)))
(defcustom flyspell-large-region 1000
@@ -282,30 +258,25 @@ Doubled words are not detected in a large region, because Ispell
does not check for them.
If this variable is nil, all regions are treated as small."
- :group 'flyspell
:version "21.1"
:type '(choice number (const :tag "All small" nil)))
(defcustom flyspell-insert-function (function insert)
"Function for inserting word by flyspell upon correction."
- :group 'flyspell
:type 'function)
(defcustom flyspell-before-incorrect-word-string nil
"String used to indicate an incorrect word starting."
- :group 'flyspell
:type '(choice string (const nil)))
(defcustom flyspell-after-incorrect-word-string nil
"String used to indicate an incorrect word ending."
- :group 'flyspell
:type '(choice string (const nil)))
(defvar flyspell-mode-map)
(defcustom flyspell-use-meta-tab t
"Non-nil means that flyspell uses M-TAB to correct word."
- :group 'flyspell
:type 'boolean
:initialize 'custom-initialize-default
:set (lambda (sym val)
@@ -316,8 +287,7 @@ If this variable is nil, all regions are treated as small."
(defcustom flyspell-auto-correct-binding
[(control ?\;)]
"The key binding for flyspell auto correction."
- :type 'key-sequence
- :group 'flyspell)
+ :type 'key-sequence)
;;*---------------------------------------------------------------------*/
;;* Mode specific options */
@@ -417,9 +387,13 @@ like <img alt=\"Some thing.\">."
;;*---------------------------------------------------------------------*/
;;* Programming mode */
;;*---------------------------------------------------------------------*/
-(defvar flyspell-prog-text-faces
+(defcustom flyspell-prog-text-faces
'(font-lock-string-face font-lock-comment-face font-lock-doc-face)
- "Faces corresponding to text in programming-mode buffers.")
+ "Faces corresponding to text in programming-mode buffers."
+ :type '(set (const font-lock-string-face)
+ (const font-lock-comment-face)
+ (const font-lock-doc-face))
+ :version "28.1")
(defun flyspell-generic-progmode-verify ()
"Used for `flyspell-generic-check-word-predicate' in programming modes."
@@ -428,8 +402,8 @@ like <img alt=\"Some thing.\">."
(let ((f (get-text-property (1- (point)) 'face)))
(memq f flyspell-prog-text-faces))))
-;; Records the binding of M-TAB in effect before flyspell was activated.
-(defvar flyspell--prev-meta-tab-binding)
+(defvar flyspell--prev-meta-tab-binding nil
+ "Records the binding of M-TAB in effect before flyspell was activated.")
;;;###autoload
(defun flyspell-prog-mode ()
@@ -475,6 +449,22 @@ like <img alt=\"Some thing.\">."
map)
"Minor mode keymap for Flyspell mode--for the whole buffer.")
+;; correct on mouse 3
+(defun flyspell--set-use-mouse-3-for-menu (var value)
+ (set-default var value)
+ (if value
+ (progn (define-key flyspell-mouse-map [mouse-2] nil)
+ (define-key flyspell-mouse-map [down-mouse-3] 'flyspell-correct-word))
+ (define-key flyspell-mouse-map [mouse-2] 'flyspell-correct-word)
+ (define-key flyspell-mouse-map [down-mouse-3] nil)))
+
+(defcustom flyspell-use-mouse-3-for-menu nil
+ "Non-nil means to bind `mouse-3' to `flyspell-correct-word'.
+If this is set, also unbind `mouse-2'."
+ :type 'boolean
+ :set 'flyspell--set-use-mouse-3-for-menu
+ :version "28.1")
+
;; dash character machinery
(defvar flyspell-consider-dash-as-word-delimiter-flag nil
"Non-nil means that the `-' char is considered as a word delimiter.")
@@ -493,8 +483,7 @@ like <img alt=\"Some thing.\">."
(t
:underline t :inherit error))
"Flyspell face for misspelled words."
- :version "24.4"
- :group 'flyspell)
+ :version "24.4")
(defface flyspell-duplicate
'((((supports :underline (:style wave)))
@@ -503,8 +492,7 @@ like <img alt=\"Some thing.\">."
:underline t :inherit warning))
"Flyspell face for words that appear twice in a row.
See also `flyspell-duplicate-distance'."
- :version "24.4"
- :group 'flyspell)
+ :version "24.4")
(defvar flyspell-overlay nil)
@@ -536,17 +524,33 @@ invoking `ispell-change-dictionary'.
Consider using the `ispell-parser' to check your text. For instance
consider adding:
-\(add-hook \\='tex-mode-hook (function (lambda () (setq ispell-parser \\='tex))))
+\(add-hook \\='tex-mode-hook (lambda () (setq ispell-parser \\='tex)))
in your init file.
\\[flyspell-region] checks all words inside a region.
\\[flyspell-buffer] checks the whole buffer."
- :lighter flyspell-mode-line-string
+ :lighter (flyspell-mode-line-string
+ ;; If `flyspell-mode-line-string' is nil, then nothing of
+ ;; the following is displayed in the mode line.
+ ((:propertize flyspell-mode-line-string)
+ (:propertize
+ (:eval
+ (concat "/" (substring (or ispell-local-dictionary
+ ispell-dictionary
+ "--")
+ 0 2)))
+ help-echo "mouse-1: Change dictionary"
+ local-map (keymap
+ (mode-line keymap
+ (mouse-1 . ispell-change-dictionary))))))
:keymap flyspell-mode-map
:group 'flyspell
(if flyspell-mode
(condition-case err
- (flyspell-mode-on)
+ (progn
+ (when flyspell-use-mouse-3-for-menu
+ (flyspell--set-use-mouse-3-for-menu 'flyspell-use-mouse-3-for-menu t))
+ (flyspell-mode-on (called-interactively-p 'interactive)))
(error (message "Error enabling Flyspell mode:\n%s" (cdr err))
(flyspell-mode -1)))
(flyspell-mode-off)))
@@ -563,12 +567,9 @@ in your init file.
(custom-add-option 'text-mode-hook 'turn-on-flyspell)
-;;*---------------------------------------------------------------------*/
-;;* flyspell-buffers ... */
-;;* ------------------------------------------------------------- */
-;;* For remembering buffers running flyspell */
-;;*---------------------------------------------------------------------*/
-(defvar flyspell-buffers nil)
+(defvar flyspell-buffers nil
+ "For remembering buffers running flyspell")
+(make-obsolete-variable 'flyspell-buffers "not used." "28.1")
;;*---------------------------------------------------------------------*/
;;* flyspell-minibuffer-p ... */
@@ -624,8 +625,12 @@ in your init file.
;;*---------------------------------------------------------------------*/
;;* flyspell-mode-on ... */
;;*---------------------------------------------------------------------*/
-(defun flyspell-mode-on ()
- "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead."
+(defun flyspell-mode-on (&optional show-msg)
+ "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead.
+
+If optional argument SHOW-MSG is non-nil, show a welcome message
+if `flyspell-issue-message-flag' and `flyspell-issue-welcome-flag'
+are both non-nil."
(ispell-set-spellchecker-params) ; Initialize variables and dicts alists
(setq ispell-highlight-face 'flyspell-incorrect)
;; local dictionaries setup
@@ -657,15 +662,17 @@ in your init file.
(setq flyspell-generic-check-word-predicate mode-predicate)))
;; the welcome message
(if (and flyspell-issue-message-flag
- flyspell-issue-welcome-flag
- (called-interactively-p 'interactive))
- (let ((binding (where-is-internal 'flyspell-auto-correct-word
- nil 'non-ascii)))
- (message "%s"
- (if binding
- (format "Welcome to flyspell. Use %s or Mouse-2 to correct words."
- (key-description binding))
- "Welcome to flyspell. Use Mouse-2 to correct words.")))))
+ flyspell-issue-welcome-flag
+ show-msg)
+ (let* ((binding (where-is-internal 'flyspell-auto-correct-word
+ nil 'non-ascii))
+ (mouse-button (if flyspell-use-mouse-3-for-menu
+ "Mouse-3" "Mouse-2")))
+ (message (format-message
+ "Welcome to Flyspell. Use %s to correct words."
+ (if binding
+ (format "`%s' or `%s'" (key-description binding) mouse-button)
+ (format "`%s'" mouse-button)))))))
;;*---------------------------------------------------------------------*/
;;* flyspell-delay-commands ... */
@@ -1815,7 +1822,9 @@ for the overlay."
(overlay-put overlay 'mouse-face mouse-face)
(overlay-put overlay 'flyspell-overlay t)
(overlay-put overlay 'evaporate t)
- (overlay-put overlay 'help-echo "mouse-2: correct word at point")
+ (overlay-put overlay 'help-echo (concat (if flyspell-use-mouse-3-for-menu
+ "mouse-3"
+ "mouse-2") ": correct word at point"))
;; If misspelled text has a 'keymap' property, let that remain in
;; effect for the bindings that flyspell-mouse-map doesn't override.
(set-keymap-parent flyspell-mouse-map (get-char-property beg 'keymap))
@@ -1912,7 +1921,7 @@ before point that's highlighted as misspelled."
(while (and (setq pos (previous-overlay-change pos))
(not (= pos pos1)))
(setq pos1 pos)
- (if (> pos (point-min))
+ (if (>= pos (point-min))
(progn
(setq ovs (overlays-at pos))
(while (consp ovs)
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 65f61644b6d..14de77cd542 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -44,6 +44,7 @@
;; ispell-buffer
;; ispell-message
;; ispell-comments-and-strings
+;; ispell-comment-or-string-at-point
;; ispell-continue
;; ispell-complete-word
;; ispell-complete-word-interior-frag
@@ -197,14 +198,13 @@ Must be greater than 1."
:type 'integer
:group 'ispell)
-;; XXX Add enchant to this list once enchant >= 2.1.0 is widespread.
-;; Before that, adding it is useless, as if it is found, it will just
-;; cause an error; and one of the other spelling engines below is
-;; almost certainly installed in any case, for enchant to use.
(defcustom ispell-program-name
(or (executable-find "aspell")
(executable-find "ispell")
(executable-find "hunspell")
+ ;; Enchant is commonly installed as `enchant-2', so use this
+ ;; name and avoid old versions of `enchant'.
+ (executable-find "enchant-2")
"ispell")
"Program invoked by \\[ispell-word] and \\[ispell-region] commands."
:type 'string
@@ -329,7 +329,7 @@ The function must take one string argument and return a string."
:group 'ispell)
;; FIXME framepop.el last updated c 2003 (?),
-;; probably something else replaces it these days.
+;; use posframe.
(defcustom ispell-use-framepop-p nil
"When non-nil ispell uses framepop to display choices in a dedicated frame.
You can set this variable to dynamically use framepop if you are in a
@@ -621,15 +621,6 @@ For Aspell, non-nil also means to try to automatically find its dictionaries.
Earlier Aspell versions do not consistently support charset encoding. Handling
this would require some extra guessing in `ispell-aspell-find-dictionary'.")
-(defvar ispell-aspell-supports-utf8 nil
- "Non-nil if Aspell has consistent command line UTF-8 support. Obsolete.
-ispell.el and flyspell.el will use for this purpose the more generic
-variable `ispell-encoding8-command' for both Aspell and Hunspell. Is left
-here just for backwards compatibility.")
-
-(make-obsolete-variable 'ispell-aspell-supports-utf8
- 'ispell-encoding8-command "23.1")
-
(defvar ispell-dicts-name2locale-equivs-alist
'(("american" "en_US")
("brasileiro" "pt_BR")
@@ -682,9 +673,7 @@ Otherwise returns the library directory name, if that is defined."
;; all versions, since versions earlier than 3.0.09 didn't identify
;; themselves on startup.
(interactive "p")
- (let ((default-directory (or (and (boundp 'temporary-file-directory)
- temporary-file-directory)
- default-directory))
+ (let ((default-directory (or temporary-file-directory default-directory))
(get-config-var
(lambda (var)
(when (re-search-forward
@@ -695,13 +684,9 @@ Otherwise returns the library directory name, if that is defined."
(with-temp-buffer
(setq status (ispell-call-process
ispell-program-name nil t nil
- ;; aspell doesn't accept the -vv switch.
(let ((case-fold-search
- (memq system-type '(ms-dos windows-nt)))
- (speller
- (file-name-nondirectory ispell-program-name)))
- ;; Assume anything that isn't `aspell' is Ispell.
- (if (string-match "\\`aspell" speller) "-v" "-vv"))))
+ (memq system-type '(ms-dos windows-nt))))
+ "-vv")))
(goto-char (point-min))
(if interactivep
;; Report version information of ispell
@@ -782,18 +767,23 @@ Otherwise returns the library directory name, if that is defined."
(setq ispell-really-hunspell nil))))))
result))
+(defmacro ispell-with-safe-default-directory (&rest body)
+ "Execute the forms in BODY with a reasonable
+`default-directory'."
+ (declare (indent 0) (debug t))
+ `(let ((default-directory default-directory))
+ (unless (file-accessible-directory-p default-directory)
+ (setq default-directory (expand-file-name "~/")))
+ ,@body))
+
(defun ispell-call-process (&rest args)
- "Like `call-process' but defend against bad `default-directory'."
- (let ((default-directory default-directory))
- (unless (file-accessible-directory-p default-directory)
- (setq default-directory (expand-file-name "~/")))
+ "Like `call-process', but defend against bad `default-directory'."
+ (ispell-with-safe-default-directory
(apply 'call-process args)))
(defun ispell-call-process-region (&rest args)
- "Like `call-process-region' but defend against bad `default-directory'."
- (let ((default-directory default-directory))
- (unless (file-accessible-directory-p default-directory)
- (setq default-directory (expand-file-name "~/")))
+ "Like `call-process-region', but defend against bad `default-directory'."
+ (ispell-with-safe-default-directory
(apply 'call-process-region args)))
(defvar ispell-debug-buffer)
@@ -1106,28 +1096,38 @@ to dictionaries found, and will remove aliases from the list
in `ispell-dicts-name2locale-equivs-alist' if an explicit
dictionary from that list was found."
(let ((hunspell-found-dicts
- (split-string
- (with-temp-buffer
- (ispell-call-process ispell-program-name
- null-device
- t
- nil
- "-D"
- ;; Use -a to prevent Hunspell from
- ;; trying to initialize its
- ;; curses/termcap UI, which causes it
- ;; to crash or fail to start in some
- ;; MS-Windows ports.
- "-a"
- ;; Hunspell 1.7.0 (and later?) won't
- ;; show LOADED DICTIONARY unless
- ;; there's at least one file argument
- ;; on the command line. So we feed
- ;; it with the null device.
- null-device)
- (buffer-string))
- "[\n\r]+"
- t))
+ (seq-filter
+ (lambda (str)
+ (when (string-match
+ ;; Hunspell gives this error when there is some
+ ;; installation problem, for example if $LANG is unset.
+ (concat "^Can't open affix or dictionary files "
+ "for dictionary named \"default\".$")
+ str)
+ (user-error "Hunspell error (is $LANG unset?): %s" str))
+ (file-name-absolute-p str))
+ (split-string
+ (with-temp-buffer
+ (ispell-call-process ispell-program-name
+ null-device
+ t
+ nil
+ "-D"
+ ;; Use -a to prevent Hunspell from
+ ;; trying to initialize its
+ ;; curses/termcap UI, which causes it
+ ;; to crash or fail to start in some
+ ;; MS-Windows ports.
+ "-a"
+ ;; Hunspell 1.7.0 (and later?) won't
+ ;; show LOADED DICTIONARY unless
+ ;; there's at least one file argument
+ ;; on the command line. So we feed
+ ;; it with the null device.
+ null-device)
+ (buffer-string))
+ "[\n\r]+"
+ t)))
hunspell-default-dict
hunspell-default-dict-entry
hunspell-multi-dict)
@@ -1217,13 +1217,14 @@ Internal use.")
(defun ispell--call-enchant-lsmod (&rest args)
"Call enchant-lsmod with ARGS and return the output as string."
(with-output-to-string
- (with-current-buffer
- standard-output
+ (with-current-buffer standard-output
(apply #'ispell-call-process
(replace-regexp-in-string "enchant\\(-[0-9]\\)?\\'"
"enchant-lsmod\\1"
ispell-program-name)
- nil t nil args))))
+ ;; We discard stderr here because enchant-lsmod can emit
+ ;; unrelated warnings that will confuse us.
+ nil '(t nil) nil args))))
(defun ispell--get-extra-word-characters (&optional lang)
"Get the extra word characters for LANG as a character class.
@@ -1237,11 +1238,11 @@ If LANG is omitted, get the extra word characters for the default language."
"Find Enchant's dictionaries, and record in `ispell-enchant-dictionary-alist'."
(let* ((dictionaries
(split-string
- (ispell--call-enchant-lsmod "-list-dicts" (buffer-string)) " ([^)]+)\n"))
+ (ispell--call-enchant-lsmod "-list-dicts") " ([^)]+)\n" t))
(found
(mapcar #'(lambda (lang)
`(,lang "[[:alpha:]]" "[^[:alpha:]]"
- ,(ispell--get-extra-word-characters) t nil nil utf-8))
+ ,(ispell--get-extra-word-characters lang) t nil nil utf-8))
dictionaries)))
;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist
;; which have no element in FOUND at all.
@@ -2463,14 +2464,14 @@ SPC: Accept word this time.
(progn
(require 'ehelp)
(with-electric-help
- (function (lambda ()
- ;;This shouldn't be necessary: with-electric-help needs
- ;; an optional argument telling it about the smallest
- ;; acceptable window-height of the help buffer.
- ;;(if (< (window-height) 15)
- ;; (enlarge-window
- ;; (- 15 (ispell-adjusted-window-height))))
- (princ "Selections are:
+ (lambda ()
+ ;;This shouldn't be necessary: with-electric-help needs
+ ;; an optional argument telling it about the smallest
+ ;; acceptable window-height of the help buffer.
+ ;;(if (< (window-height) 15)
+ ;; (enlarge-window
+ ;; (- 15 (ispell-adjusted-window-height))))
+ (princ "Selections are:
DIGIT: Replace the word with a digit offered in the *Choices* buffer.
SPC: Accept word this time.
@@ -2490,7 +2491,7 @@ SPC: Accept word this time.
`C-l': Redraw screen.
`C-r': Recursive edit.
`C-z': Suspend Emacs or iconify frame.")
- nil))))
+ nil)))
(let ((help-1 (concat "[r/R]eplace word; [a/A]ccept for this session; "
@@ -3273,15 +3274,15 @@ otherwise, the current line is skipped."
Generated from `ispell-tex-skip-alists'."
(concat
;; raw tex keys
- (mapconcat (function (lambda (lst) (car lst)))
+ (mapconcat (lambda (lst) (car lst))
(car ispell-tex-skip-alists)
"\\|")
"\\|"
;; keys wrapped in begin{}
- (mapconcat (function (lambda (lst)
- (concat "\\\\begin[ \t\n]*{[ \t\n]*"
- (car lst)
- "[ \t\n]*}")))
+ (mapconcat (lambda (lst)
+ (concat "\\\\begin[ \t\n]*{[ \t\n]*"
+ (car lst)
+ "[ \t\n]*}"))
(car (cdr ispell-tex-skip-alists))
"\\|")))
@@ -3591,24 +3592,40 @@ Returns the sum SHIFT due to changes in word replacements."
;;;###autoload
-(defun ispell-comments-and-strings ()
- "Check comments and strings in the current buffer for spelling errors."
- (interactive)
- (goto-char (point-min))
+(defun ispell-comments-and-strings (&optional start end)
+ "Check comments and strings in the current buffer for spelling errors.
+If called interactively with an active region, check only comments and
+strings in the region.
+When called from Lisp, START and END buffer positions can be provided
+to limit the check."
+ (interactive (when (use-region-p) (list (region-beginning) (region-end))))
+ (unless end (setq end (point-max)))
+ (goto-char (or start (point-min)))
(let (state done)
(while (not done)
(setq done t)
- (setq state (parse-partial-sexp (point) (point-max)
- nil nil state 'syntax-table))
+ (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table))
(if (or (nth 3 state) (nth 4 state))
(let ((start (point)))
- (setq state (parse-partial-sexp start (point-max)
+ (setq state (parse-partial-sexp start end
nil nil state 'syntax-table))
(if (or (nth 3 state) (nth 4 state))
(error "Unterminated string or comment"))
(save-excursion
(setq done (not (ispell-region start (point))))))))))
+;;;###autoload
+(defun ispell-comment-or-string-at-point ()
+ "Check the comment or string containing point for spelling errors."
+ (interactive)
+ (save-excursion
+ (let ((state (syntax-ppss)))
+ (if (or (nth 3 state) (nth 4 state))
+ (ispell-region (nth 8 state)
+ (progn (parse-partial-sexp (point) (point-max)
+ nil nil state 'syntax-table)
+ (point)))
+ (user-error "Not inside a string or comment")))))
;;;###autoload
(defun ispell-buffer ()
@@ -3687,11 +3704,10 @@ Standard ispell choices are then available."
((string-equal (upcase word) word)
(setq possibilities (mapcar #'upcase possibilities)))
((eq (upcase (aref word 0)) (aref word 0))
- (setq possibilities (mapcar (function
- (lambda (pos)
- (if (eq (aref word 0) (aref pos 0))
- pos
- (capitalize pos))))
+ (setq possibilities (mapcar (lambda (pos)
+ (if (eq (aref word 0) (aref pos 0))
+ pos
+ (capitalize pos)))
possibilities))))
(setq case-fold-search case-fold-search-val)
(save-window-excursion
@@ -3734,8 +3750,7 @@ looking for a dictionary, please see the distribution of the GNU ispell
program, or do an Internet search; there are various dictionaries
available on the net."
(interactive)
- (if (and (boundp 'transient-mark-mode) transient-mark-mode
- (boundp 'mark-active) mark-active)
+ (if (and transient-mark-mode mark-active)
(ispell-region (region-beginning) (region-end))
(ispell-buffer)))
@@ -3923,7 +3938,7 @@ in your init file:
You can bind this to the key C-c i in GNUS or mail by adding to
`news-reply-mode-hook' or `mail-mode-hook' the following lambda expression:
- (function (lambda () (local-set-key \"\\C-ci\" \\='ispell-message)))"
+ (lambda () (local-set-key \"\\C-ci\" \\='ispell-message))"
(interactive)
(save-excursion
(goto-char (point-min))
@@ -4200,7 +4215,7 @@ Both should not be used to define a buffer-local dictionary."
(let (line-okay search done found)
(while (not done)
(let ((case-fold-search nil))
- (setq search (search-forward ispell-words-keyword nil 'move)
+ (setq search (search-forward ispell-words-keyword nil t)
found (or found search)
line-okay (< (+ (length word) 1 ; 1 for space after word..
(progn (end-of-line) (current-column)))
@@ -4211,8 +4226,10 @@ Both should not be used to define a buffer-local dictionary."
(setq done t)
(if (null search)
(progn
- (open-line 1)
- (unless found (newline))
+ (if found (insert "\n") ;; after an existing LocalWords
+ (goto-char (point-max)) ;; no LocalWords, go to end of file
+ (open-line 1)
+ (newline))
(insert (if comment-start
(concat
(progn
diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el
index b9161d9697e..329f3e7241d 100644
--- a/lisp/textmodes/mhtml-mode.el
+++ b/lisp/textmodes/mhtml-mode.el
@@ -22,6 +22,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'pcase))
(require 'sgml-mode)
(require 'js)
(require 'css-mode)
@@ -73,7 +74,9 @@ code();
(defconst mhtml--crucial-variable-prefix
(regexp-opt '("comment-" "uncomment-" "electric-indent-"
- "smie-" "forward-sexp-function" "completion-" "major-mode"))
+ "smie-" "forward-sexp-function" "completion-" "major-mode"
+ "adaptive-fill-" "fill-" "normal-auto-fill-function"
+ "paragraph-"))
"Regexp matching the prefix of \"crucial\" buffer-locals we want to capture.")
(defconst mhtml--variable-prefix
@@ -157,54 +160,6 @@ code();
(mhtml--submode-name submode)
"")))
-(defvar font-lock-beg)
-(defvar font-lock-end)
-
-(defun mhtml--extend-font-lock-region ()
- "Extend the font lock region according to HTML sub-mode needs.
-
-This is used via `font-lock-extend-region-functions'. It ensures
-that the font-lock region is extended to cover either whole
-lines, or to the spot where the submode changes, whichever is
-smallest."
- (let ((orig-beg font-lock-beg)
- (orig-end font-lock-end))
- ;; The logic here may look odd but it is needed to ensure that we
- ;; do the right thing when trying to limit the search.
- (save-excursion
- (goto-char font-lock-beg)
- ;; previous-single-property-change starts by looking at the
- ;; previous character, but we're trying to extend a region to
- ;; include just characters with the same submode as this
- ;; character.
- (unless (eobp)
- (forward-char))
- (setq font-lock-beg (previous-single-property-change
- (point) 'mhtml-submode nil
- (line-beginning-position)))
- (unless (eq (get-text-property font-lock-beg 'mhtml-submode)
- (get-text-property orig-beg 'mhtml-submode))
- (cl-incf font-lock-beg))
-
- (goto-char font-lock-end)
- (unless (bobp)
- (backward-char))
- (setq font-lock-end (next-single-property-change
- (point) 'mhtml-submode nil
- (line-beginning-position 2)))
- (unless (eq (get-text-property font-lock-end 'mhtml-submode)
- (get-text-property orig-end 'mhtml-submode))
- (cl-decf font-lock-end)))
-
- ;; Also handle the multiline property -- but handle it here, and
- ;; not via font-lock-extend-region-functions, to avoid the
- ;; situation where the two extension functions disagree.
- ;; See bug#29159.
- (font-lock-extend-region-multiline)
-
- (or (/= font-lock-beg orig-beg)
- (/= font-lock-end orig-end))))
-
(defun mhtml--submode-fontify-one-region (submode beg end &optional loudly)
(if submode
(mhtml--with-locals submode
@@ -303,17 +258,14 @@ This is used by `mhtml--pre-command'.")
sgml-syntax-propertize-rules))
(defun mhtml-syntax-propertize (start end)
- ;; First remove our special settings from the affected text. They
- ;; will be re-applied as needed.
- (remove-list-of-text-properties start end
- '(syntax-table local-map mhtml-submode))
- (goto-char start)
- ;; Be sure to look back one character, because START won't yet have
- ;; been propertized.
- (unless (bobp)
- (let ((submode (get-text-property (1- (point)) 'mhtml-submode)))
- (if submode
- (mhtml--syntax-propertize-submode submode end))))
+ (let ((submode (get-text-property start 'mhtml-submode)))
+ ;; First remove our special settings from the affected text. They
+ ;; will be re-applied as needed.
+ (remove-list-of-text-properties start end
+ '(syntax-table local-map mhtml-submode))
+ (goto-char start)
+ (if submode
+ (mhtml--syntax-propertize-submode submode end)))
(sgml-syntax-propertize (point) end mhtml--syntax-propertize))
(defun mhtml-indent-line ()
@@ -352,6 +304,17 @@ This is used by `mhtml--pre-command'.")
(flyspell-generic-progmode-verify)
t)))
+;; Support for hideshow.el (see `hs-special-modes-alist').
+(defun mhtml-forward (arg)
+ "Move point forward past a structured expression.
+If point is on a tag, move to the end of the tag.
+Otherwise, this calls `forward-sexp'.
+Prefix arg specifies how many times to move (default 1)."
+ (interactive "P")
+ (pcase (get-text-property (point) 'mhtml-submode)
+ ('nil (sgml-skip-tag-forward arg))
+ (submode (forward-sexp arg))))
+
;;;###autoload
(define-derived-mode mhtml-mode html-mode
'((sgml-xml-mode "XHTML+" "HTML+") (:eval (mhtml--submode-lighter)))
@@ -364,8 +327,6 @@ the rules from `css-mode'."
(setq-local syntax-propertize-function #'mhtml-syntax-propertize)
(setq-local font-lock-fontify-region-function
#'mhtml--submode-fontify-region)
- (setq-local font-lock-extend-region-functions
- '(mhtml--extend-font-lock-region))
;; Attach this to both pre- and post- hooks just in case it ever
;; changes a key binding that might be accessed from the menu bar.
@@ -383,6 +344,18 @@ the rules from `css-mode'."
;: Hack
(js--update-quick-match-re)
+ ;; Setup the appropriate js-mode value of auto-fill-function.
+ (setf (mhtml--submode-crucial-captured-locals mhtml--js-submode)
+ (push (cons 'auto-fill-function
+ (if (and (boundp 'auto-fill-function) auto-fill-function)
+ #'js-do-auto-fill
+ nil))
+ (mhtml--submode-crucial-captured-locals mhtml--js-submode)))
+
+ ;; This mode might be using CC Mode's filling functionality.
+ (c-foreign-init-lit-pos-cache)
+ (add-hook 'before-change-functions #'c-foreign-truncate-lit-pos-cache nil t)
+
;; This is sort of a prog-mode as well as a text mode.
(run-hooks 'prog-mode-hook))
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index 62e8b1f0934..bb2582cf7a2 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -50,7 +50,6 @@
(let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap)))
(define-key map "\t" 'tab-to-tab-stop)
- (define-key map "\es" 'center-line)
(define-key map "\e?" 'nroff-count-text-lines)
(define-key map "\n" 'nroff-electric-newline)
(define-key map "\en" 'nroff-forward-text-line)
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
index c2b7b66b9f7..b357bbbbe97 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -429,20 +429,19 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort)."
;; NEXTRECFUN is called with point at the end of the
;; previous record. It moves point to the start of the
;; next record.
- (function (lambda ()
- (re-search-forward page-delimiter nil t)
- (skip-chars-forward " \t\n")
- ))
+ (lambda ()
+ (re-search-forward page-delimiter nil t)
+ (skip-chars-forward " \t\n"))
;; ENDRECFUN is called with point within the record.
;; It should move point to the end of the record.
- (function (lambda ()
- (if (re-search-forward
- page-delimiter
- nil
- t)
- (goto-char (match-beginning 0))
- (goto-char (point-max))))))))
+ (lambda ()
+ (if (re-search-forward
+ page-delimiter
+ nil
+ t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max)))))))
(define-obsolete-function-alias 'sort-pages-buffer #'pages-sort-buffer "27.1")
(defun pages-sort-buffer (&optional reverse)
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 99c3e471241..b0975291428 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -168,7 +168,7 @@ to obtain the value of this variable."
(defcustom sentence-end-base "[.?!…‽][]\"'â€â€™)}»›]*"
"Regexp matching the basic end of a sentence, not including following space."
:group 'paragraphs
- :type 'string
+ :type 'regexp
:version "25.1")
(put 'sentence-end-base 'safe-local-variable 'stringp)
@@ -371,33 +371,50 @@ See `forward-paragraph' for more information."
(defun mark-paragraph (&optional arg allow-extend)
"Put point at beginning of this paragraph, mark at end.
-The paragraph marked is the one that contains point or follows point.
+The paragraph marked is the one that contains point or follows
+point.
-With argument ARG, puts mark at end of a following paragraph, so that
-the number of paragraphs marked equals ARG.
+With argument ARG, puts mark at the end of this or a following
+paragraph, so that the number of paragraphs marked equals ARG.
-If ARG is negative, point is put at end of this paragraph, mark is put
-at beginning of this or a previous paragraph.
+If ARG is negative, point is put at the end of this paragraph,
+mark is put at the beginning of this or a previous paragraph.
Interactively (or if ALLOW-EXTEND is non-nil), if this command is
-repeated or (in Transient Mark mode) if the mark is active,
-it marks the next ARG paragraphs after the ones already marked."
- (interactive "p\np")
- (unless arg (setq arg 1))
- (when (zerop arg)
- (error "Cannot mark zero paragraphs"))
- (cond ((and allow-extend
- (or (and (eq last-command this-command) (mark t))
- (and transient-mark-mode mark-active)))
- (set-mark
- (save-excursion
- (goto-char (mark))
- (forward-paragraph arg)
- (point))))
- (t
- (forward-paragraph arg)
- (push-mark nil t t)
- (backward-paragraph arg))))
+repeated or (in Transient Mark mode) if the mark is active, it
+marks the next ARG paragraphs after the region already marked.
+This also means when activating the mark immediately before using
+this command, the current paragraph is only marked from point."
+ (interactive "P\np")
+ (let ((numeric-arg (prefix-numeric-value arg)))
+ (cond ((zerop numeric-arg))
+ ((and allow-extend
+ (or (and (eq last-command this-command) mark-active)
+ (region-active-p)))
+ (if arg
+ (setq arg numeric-arg)
+ (if (< (mark) (point))
+ (setq arg -1)
+ (setq arg 1)))
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ (forward-paragraph arg)
+ (point))))
+ ;; don't activate the mark when at eob
+ ((and (eobp) (> numeric-arg 0)))
+ (t
+ (unless (save-excursion
+ (forward-line 0)
+ (looking-at paragraph-start))
+ (backward-paragraph (cond ((> numeric-arg 0) 1)
+ ((< numeric-arg 0) -1)
+ (t 0))))
+ (push-mark
+ (save-excursion
+ (forward-paragraph numeric-arg)
+ (point))
+ t t)))))
(defun kill-paragraph (arg)
"Kill forward to end of paragraph.
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 7a82f8f0e6a..5216812b587 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -1,4 +1,4 @@
-;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
+;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1994, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el
index d5645e86304..29c6d3f4608 100644
--- a/lisp/textmodes/po.el
+++ b/lisp/textmodes/po.el
@@ -1,4 +1,4 @@
-;;; po.el --- basic support of PO translation files
+;;; po.el --- basic support of PO translation files -*- lexical-binding:t -*-
;; Copyright (C) 1995-1998, 2000-2020 Free Software Foundation, Inc.
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index 8d8223a7326..888c310b4a1 100644
--- a/lisp/textmodes/refer.el
+++ b/lisp/textmodes/refer.el
@@ -249,9 +249,9 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
(forward-paragraph 1)
(setq end (point))
(setq found
- (refer-every (function (lambda (keyword)
- (goto-char begin)
- (re-search-forward keyword end t)))
+ (refer-every (lambda (keyword)
+ (goto-char begin)
+ (re-search-forward keyword end t))
keywords-list))
(if (not found)
(progn
@@ -336,9 +336,9 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
(list (expand-file-name
(if (eq major-mode 'bibtex-mode)
(read-file-name
- (format ".bib file (default %s): "
- (file-name-nondirectory
- (buffer-file-name)))
+ (format-prompt ".bib file"
+ (file-name-nondirectory
+ (buffer-file-name)))
(file-name-directory (buffer-file-name))
(file-name-nondirectory (buffer-file-name))
t)
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index b79bb292c8a..4c780d8d8c3 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -861,9 +861,7 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window."
(default (when (looking-back "\\\\\\(?:page\\)?ref{[-a-zA-Z0-9_*.:]*"
(line-beginning-position))
(reftex-this-word "-a-zA-Z0-9_*.:")))
- (label (completing-read (if default
- (format "Label (default %s): " default)
- "Label: ")
+ (label (completing-read (format-prompt "Label" default)
docstruct
(lambda (x) (stringp (car x))) t nil nil
default))
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index ca92541331e..c9fd19d2324 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -925,7 +925,7 @@ DOWNCASE t: Downcase words before using them."
"\\<label[[:space:]]*=[[:space:]]*"
;; Match the label value; braces around the value are
;; optional.
- "{?\\(?1:[^] ,}\r\n\t%]+\\)}?"
+ "{?\\(?1:[^] ,}\r\n\t%]+\\)"
;; We are done. Just search until the next closing bracket
"[^]]*\\]"))
"List of regexps matching \\label definitions.
@@ -2100,6 +2100,8 @@ construct: \\bbb [xxx] {aaa}."
"Hook which is being run when loading reftex.el."
:group 'reftex-miscellaneous-configurations
:type 'hook)
+(make-obsolete-variable 'reftex-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom reftex-mode-hook nil
"Hook which is being run when turning on RefTeX mode."
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index 542f1fef14e..4071c0dd074 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -2371,7 +2371,7 @@ what in fact did happen.
Check if the bug is reproducible with an up-to-date version of
RefTeX available from https://www.gnu.org/software/auctex/.
-If the bug is triggered by a specific \(La)TeX file, you should try
+If the bug is triggered by a specific (La)TeX file, you should try
to produce a minimal sample file showing the problem and include it
in your report.
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 836dfb4a538..7bc7dc1762e 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -5,7 +5,7 @@
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: emacs-devel@gnu.org
;; Created: 29 Mar 1999
-;; Version: 2.0
+;; Old-Version: 2.0
;; Keywords: data memory todo pim
;; URL: http://gna.org/projects/remember-el/
@@ -181,6 +181,7 @@
(defconst remember-version "2.0"
"This version of remember.")
+(make-obsolete-variable 'remember-version nil "28.1")
(defgroup remember nil
"A mode to remember information."
@@ -486,9 +487,6 @@ Most useful for remembering things from other applications."
(interactive)
(remember-region (point-min) (point-max)))
-;; Org needs this
-(define-obsolete-function-alias 'remember-buffer 'remember-finalize "23.1")
-
(defun remember-destroy ()
"Destroy the current *Remember* buffer."
(interactive)
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 5fadec491a5..adda28cb81b 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -2363,7 +2363,7 @@ If user selects enumerations, a further prompt is given. User need to
input a starting item, for example 'e' for 'A)' style. The position is
also arranged by `rst-insert-list-new-tag'."
(let* ((itemstyle (completing-read
- "Select preferred item style [#.]: "
+ (format-prompt "Select preferred item style" "#.")
rst-initial-items nil t nil nil "#."))
(cnt (if (string-match (rst-re 'cntexp-tag) itemstyle)
(match-string 0 itemstyle)))
@@ -2371,21 +2371,23 @@ also arranged by `rst-insert-list-new-tag'."
(save-match-data
(cond
((equal cnt "a")
- (let ((itemno (read-string "Give starting value [a]: "
- nil nil "a")))
+ (let ((itemno (read-string
+ (format-prompt "Give starting value" "a")
+ nil nil "a")))
(downcase (substring itemno 0 1))))
((equal cnt "A")
- (let ((itemno (read-string "Give starting value [A]: "
- nil nil "A")))
+ (let ((itemno (read-string
+ (format-prompt "Give starting value" "A")
+ nil nil "A")))
(upcase (substring itemno 0 1))))
((equal cnt "I")
- (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (let ((itemno (read-number "Give starting value: " 1)))
(rst-arabic-to-roman itemno)))
((equal cnt "i")
- (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (let ((itemno (read-number "Give starting value: " 1)))
(downcase (rst-arabic-to-roman itemno))))
((equal cnt "1")
- (let ((itemno (read-number "Give starting value [1]: " 1)))
+ (let ((itemno (read-number "Give starting value: " 1)))
(number-to-string itemno)))))))
(if no
(setq itemstyle (replace-match no t t itemstyle)))
@@ -2860,7 +2862,7 @@ file-write hook to always make it up-to-date automatically."
;; FIXME: Updating the toc on saving would be nice. However, this doesn't work
;; correctly:
;;
-;; (add-hook 'write-contents-hooks 'rst-toc-update-fun)
+;; (add-hook 'write-contents-functions 'rst-toc-update-fun)
;; (defun rst-toc-update-fun ()
;; ;; Disable undo for the write file hook.
;; (let ((buffer-undo-list t)) (rst-toc-update) ))
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 6152a8ad0a7..f3d8695e248 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -46,7 +46,8 @@
(defcustom sgml-basic-offset 2
"Specifies the basic indentation level for `sgml-indent-line'."
- :type 'integer)
+ :type 'integer
+ :safe #'integerp)
(defcustom sgml-attribute-offset 0
"Specifies a delta for attribute indentation in `sgml-indent-line'.
@@ -286,7 +287,10 @@ separated by a space."
(defconst sgml-namespace-re "[_[:alpha:]][-_.[:alnum:]]*")
(defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*")
(defconst sgml-tag-name-re (concat "<\\([!/?]?" sgml-name-re "\\)"))
-(defconst sgml-attrs-re "\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*")
+(defconst sgml-attrs-re
+ ;; This pattern cannot begin with a character matched by the end of
+ ;; `sgml-name-re' above.
+ "\\(?:[^_.:\"'/><[:alnum:]-]\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?")
(defconst sgml-start-tag-regex (concat "<" sgml-name-re sgml-attrs-re)
"Regular expression that matches a non-empty start tag.
Any terminating `>' or `/' is not matched.")
@@ -775,7 +779,7 @@ If you like tags and attributes in uppercase, customize
(setq sgml-tag-last
(completing-read
(if (> (length sgml-tag-last) 0)
- (format "Tag (default %s): " sgml-tag-last)
+ (format-prompt "Tag" sgml-tag-last)
"Tag: ")
sgml-tag-alist nil nil nil 'sgml-tag-history sgml-tag-last)))
?< str |
@@ -874,9 +878,7 @@ With prefix argument, only self insert."
(list (let ((def (save-excursion
(if (eq (following-char) ?<) (forward-char))
(sgml-beginning-of-tag))))
- (completing-read (if def
- (format "Tag (default %s): " def)
- "Tag: ")
+ (completing-read (format-prompt "Tag" def)
sgml-tag-alist nil nil nil
'sgml-tag-history def))))
(or (and tag (> (length tag) 0))
@@ -1186,10 +1188,9 @@ and move to the line in the SGML document that caused it."
(or sgml-saved-validate-command
(concat sgml-validate-command
" "
- (shell-quote-argument
- (let ((name (buffer-file-name)))
- (and name
- (file-name-nondirectory name)))))))))
+ (when-let ((name (buffer-file-name)))
+ (shell-quote-argument
+ (file-name-nondirectory name))))))))
(setq sgml-saved-validate-command command)
(save-some-buffers (not compilation-ask-about-save) nil)
(compilation-start command))
@@ -1803,6 +1804,7 @@ This takes effect when first loading the library.")
(define-key map "\C-c\C-cc" 'html-checkboxes)
(define-key map "\C-c\C-cl" 'html-list-item)
(define-key map "\C-c\C-ch" 'html-href-anchor)
+ (define-key map "\C-c\C-cf" 'html-href-anchor-file)
(define-key map "\C-c\C-cn" 'html-name-anchor)
(define-key map "\C-c\C-c#" 'html-id-anchor)
(define-key map "\C-c\C-ci" 'html-image)
@@ -1815,6 +1817,7 @@ This takes effect when first loading the library.")
(define-key map "\C-cc" 'html-checkboxes)
(define-key map "\C-cl" 'html-list-item)
(define-key map "\C-ch" 'html-href-anchor)
+ (define-key map "\C-cf" 'html-href-anchor-file)
(define-key map "\C-cn" 'html-name-anchor)
(define-key map "\C-c#" 'html-id-anchor)
(define-key map "\C-ci" 'html-image)
@@ -1842,15 +1845,16 @@ This takes effect when first loading the library.")
(define-key menu-map "\n" '("Line Break" . html-line))
(define-key menu-map "\r" '("Paragraph" . html-paragraph))
(define-key menu-map "i" '("Image" . html-image))
- (define-key menu-map "h" '("Href Anchor" . html-href-anchor))
+ (define-key menu-map "h" '("Href Anchor URL" . html-href-anchor))
+ (define-key menu-map "f" '("Href Anchor File" . html-href-anchor-file))
(define-key menu-map "n" '("Name Anchor" . html-name-anchor))
(define-key menu-map "#" '("ID Anchor" . html-id-anchor))
map)
"Keymap for commands for use in HTML mode.")
(defvar html-face-tag-alist
- '((bold . "b")
- (italic . "i")
+ '((bold . "strong")
+ (italic . "em")
(underline . "u")
(mode-line . "rev"))
"Value of `sgml-face-tag-alist' for HTML mode.")
@@ -2360,7 +2364,7 @@ have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are
ignored unless the text is <pre>preformatted.</pre> Text can be marked as
-<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-o or
+<strong>bold</strong>, <em>italic</em> or <u>underlined</u> using the normal M-o or
Edit/Text Properties/Face commands.
Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
@@ -2450,6 +2454,11 @@ HTML Autoview mode is a buffer-local minor mode for use with
;; '(setq input "http:")
"<a href=\"" str "\">" _ "</a>")
+(define-skeleton html-href-anchor-file
+ "HTML anchor tag with href attribute (from a local file)."
+ (file-relative-name (read-file-name "File name: ") default-directory)
+ "<a href=\"" str "\">" _ "</a>")
+
(define-skeleton html-name-anchor
"HTML anchor tag with name attribute."
"Name: "
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index bd2cac7aebb..25aa58046f4 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -339,8 +339,8 @@
;; When using `table-cell-map-hook' do not use `local-set-key'.
;;
;; (add-hook 'table-cell-map-hook
-;; (function (lambda ()
-;; (local-set-key [<key sequence>] '<function>))))
+;; (lambda ()
+;; (local-set-key [<key sequence>] '<function>)))
;;
;; Adding the above to your init file is a common way to customize a
;; mode specific keymap. However it does not work for this package.
@@ -349,8 +349,8 @@
;; explicitly. The correct way of achieving above task is:
;;
;; (add-hook 'table-cell-map-hook
-;; (function (lambda ()
-;; (define-key table-cell-map [<key sequence>] '<function>))))
+;; (lambda ()
+;; (define-key table-cell-map [<key sequence>] '<function>)))
;;
;; -----
;; Menu:
@@ -793,6 +793,8 @@ simply by any key input."
"List of functions to be called after the table is first loaded."
:type 'hook
:group 'table-hooks)
+(make-obsolete-variable 'table-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom table-point-entered-cell-hook nil
"List of functions to be called after point entered a table cell."
@@ -1822,11 +1824,11 @@ See `table-insert-row' and `table-insert-column'."
(list (intern (let ((completion-ignore-case t)
(default (car table-insert-row-column-history)))
(downcase (completing-read
- (format "Insert %s row%s/column%s (default %s): "
- (if (> n 1) (format "%d" n) "a")
- (if (> n 1) "s" "")
- (if (> n 1) "s" "")
- default)
+ (format-prompt
+ "Insert %s row%s/column%s" default
+ (if (> n 1) (format "%d" n) "a")
+ (if (> n 1) "s" "")
+ (if (> n 1) "s" ""))
'(("row") ("column"))
nil t nil 'table-insert-row-column-history default))))
n)))
@@ -2532,7 +2534,7 @@ DIRECTION is one of symbols; right, left, above or below."
(caar direction-list)))
(completion-ignore-case t))
(intern (downcase (completing-read
- (format "Span into (default %s): " default-direction)
+ (format-prompt "Span into" default-direction)
direction-list
nil t nil 'table-cell-span-direction-history default-direction))))))
(unless (memq direction '(right left above below))
@@ -2695,7 +2697,7 @@ Creates a cell on the left and a cell on the right of the current point location
("Title"
("Split" . "split") ("Left" . "left") ("Right" . "right"))))
(downcase (completing-read
- (format "Existing cell contents to (default %s): " default)
+ (format-prompt "Existing cell contents to" default)
'(("split") ("left") ("right"))
nil t nil 'table-cell-split-contents-to-history default)))))))
(unless (eq contents-to 'split)
@@ -2767,7 +2769,7 @@ ORIENTATION is a symbol either horizontally or vertically."
(completion-ignore-case t)
(default (car table-cell-split-orientation-history)))
(intern (downcase (completing-read
- (format "Split orientation (default %s): " default)
+ (format-prompt "Split orientation" default)
'(("horizontally") ("vertically"))
nil t nil 'table-cell-split-orientation-history default))))))
(unless (memq orientation '(horizontally vertically))
@@ -2787,7 +2789,7 @@ WHAT is a symbol `cell', `row' or `column'. JUSTIFY is a symbol
(completion-ignore-case t)
(default (car table-target-history)))
(intern (downcase (completing-read
- (format "Justify what (default %s): " default)
+ (format-prompt "Justify what" default)
'(("cell") ("row") ("column"))
nil t nil 'table-target-history default))))
(table--query-justification)))
@@ -2927,7 +2929,7 @@ buffer, and leaves the previous contents of the buffer untouched.
References used for this implementation:
HTML:
- URL `http://www.w3.org'
+ URL `https://www.w3.org'
LaTeX:
URL `http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html'
@@ -2941,7 +2943,7 @@ CALS (DocBook DTD):
(completion-ignore-case t)
(default (car table-source-language-history))
(language (downcase (completing-read
- (format "Language (default %s): " default)
+ (format-prompt "Language" default)
table-source-languages
nil t nil 'table-source-language-history default))))
(list
@@ -3207,11 +3209,7 @@ CALS (DocBook DTD):
(while (and (re-search-forward "$" nil t)
(not (eobp)))
(insert "<br />")
- (forward-char 1)))
- (unless (and table-html-delegate-spacing-to-user-agent
- (progn
- (goto-char (point-min))
- (looking-at "\\s *\\'")))))
+ (forward-char 1))))
((eq language 'cals)
(table--remove-eol-spaces (point-min) (point-max))
(if (re-search-forward "\\s +\\'" nil t)
@@ -3281,7 +3279,7 @@ Currently this method is for LaTeX only."
(with-temp-buffer
(insert line)
(goto-char (point-min))
- (while (re-search-forward "\\([#$~_^%{}]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
+ (while (re-search-forward "\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t)
(if (match-beginning 1)
(save-excursion
(goto-char (match-beginning 1))
@@ -3368,7 +3366,7 @@ Example:
(let* ((completion-ignore-case t)
(default (car table-sequence-justify-history)))
(intern (downcase (completing-read
- (format "Justify (default %s): " default)
+ (format-prompt "Justify" default)
'(("left") ("center") ("right"))
nil t nil 'table-sequence-justify-history default)))))))
(unless (or (called-interactively-p 'interactive) (table--probe-cell))
@@ -3505,9 +3503,9 @@ column must consists from cells of same width."
(let ((cell-list (table--vertical-cell-list 'top-to-bottom)))
(unless
(and (table--uniform-list-p
- (mapcar (function (lambda (cell) (car (table--get-coordinate (car cell))))) cell-list))
+ (mapcar (lambda (cell) (car (table--get-coordinate (car cell)))) cell-list))
(table--uniform-list-p
- (mapcar (function (lambda (cell) (car (table--get-coordinate (cdr cell))))) cell-list)))
+ (mapcar (lambda (cell) (car (table--get-coordinate (cdr cell)))) cell-list)))
(error "Cells in this column are not in uniform width"))
(unless lu-coord
(setq lu-coord (table--get-coordinate (caar cell-list))))
@@ -3670,7 +3668,7 @@ companion command to `table-capture' this way.
(if (and (string= col-delim-regexp "") (string= row-delim-regexp "")) 'left
(intern
(downcase (completing-read
- (format "Justify (default %s): " default)
+ (format-prompt "Justify" default)
'(("left") ("center") ("right"))
nil t nil 'table-capture-justify-history default)))))
(if (and (string= col-delim-regexp "") (string= row-delim-regexp "")) "1"
@@ -4255,9 +4253,8 @@ cache buffer into the designated cell in the table buffer."
PROMPT-HISTORY is a cons cell which car is the prompt string and the
cdr is the history symbol."
(let ((default (car (symbol-value (cdr prompt-history)))))
- (read-from-minibuffer
- (format "%s (default %s): " (car prompt-history) default)
- "" nil nil (cdr prompt-history) default))
+ (read-from-minibuffer (format-prompt (car prompt-history) default)
+ "" nil nil (cdr prompt-history) default))
(car (symbol-value (cdr prompt-history))))
(defun table--buffer-substring-and-trim (beg end)
@@ -4314,7 +4311,7 @@ Returns the coordinate of the final point location."
(let* ((completion-ignore-case t)
(default (car table-justify-history)))
(intern (downcase (completing-read
- (format "Justify (default %s): " default)
+ (format-prompt "Justify" default)
'(("left") ("center") ("right") ("top") ("middle") ("bottom") ("none"))
nil t nil 'table-justify-history default)))))
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 0e28756ea75..37ab11ad89f 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -224,7 +224,7 @@ Should show the queue(s) that \\[tex-print] puts jobs on."
:group 'tex-view)
;;;###autoload
-(defcustom tex-default-mode 'latex-mode
+(defcustom tex-default-mode #'latex-mode
"Mode to enter for a new file that might be either TeX or LaTeX.
This variable is used when it can't be determined whether the file
is plain TeX or LaTeX or what because the file contains no commands.
@@ -422,7 +422,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
(push (cons "--" (match-beginning 0)) menu))
;; Sort in increasing buffer position order.
- (sort menu (function (lambda (a b) (< (cdr a) (cdr b))))))))
+ (sort menu (lambda (a b) (< (cdr a) (cdr b)))))))
;;;;
;;;; Outline support
@@ -465,7 +465,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
; ("{\\\\bf\\([^}]+\\)}" 1 'bold keep)
; ("{\\\\\\(em\\|it\\|sl\\)\\([^}]+\\)}" 2 'italic keep)
; ("\\\\\\([a-zA-Z@]+\\|.\\)" . font-lock-keyword-face)
-; ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face keep))
+; ("^[ \t\n]*\\\\def[\\@]\\(\\w+\\)" 1 font-lock-function-name-face keep))
; ;; Rewritten and extended for LaTeX2e by Ulrik Dickow <dickow@nbi.dk>.
; '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}"
; 2 font-lock-function-name-face)
@@ -593,7 +593,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
;; Miscellany.
(slash "\\\\")
(opt " *\\(\\[[^]]*\\] *\\)*")
- (args "\\(\\(?:[^{}&\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")
+ (args "\\(\\(?:[^${}&\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")
(arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)"))
(list
;;
@@ -668,7 +668,9 @@ An alternative value is \" . \", if you use a font with a narrow period."
"Default expressions to highlight in TeX modes.")
(defvar tex-verbatim-environments
- '("verbatim" "verbatim*"))
+ '("verbatim" "verbatim*"
+ "Verbatim" ;; From "fancyvrb"
+ ))
(put 'tex-verbatim-environments 'safe-local-variable
(lambda (x) (not (memq nil (mapcar #'stringp x)))))
@@ -966,7 +968,7 @@ Inherits `shell-mode-map' with a few additions.")
;; This would be a lot simpler if we just used a regexp search,
;; but then it would be too slow.
-(defun tex-guess-mode ()
+(defun tex--guess-mode ()
(let ((mode tex-default-mode) slash comment)
(save-excursion
(goto-char (point-min))
@@ -983,52 +985,40 @@ Inherits `shell-mode-map' with a few additions.")
(regexp-opt '("documentstyle" "documentclass"
"begin" "subsection" "section"
"part" "chapter" "newcommand"
- "renewcommand" "RequirePackage") 'words)
+ "renewcommand" "RequirePackage")
+ 'words)
"\\|NeedsTeXFormat{LaTeX")))
(if (and (looking-at
"document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}")
;; SliTeX is almost never used any more nowadays.
(tex-executable-exists-p slitex-run-command))
- 'slitex-mode
- 'latex-mode)
- 'plain-tex-mode))))
- (funcall mode)))
+ #'slitex-mode
+ #'latex-mode)
+ #'plain-tex-mode))))
+ mode))
;; `tex-mode' plays two roles: it's the parent of several sub-modes
;; but it's also the function that chooses between those submodes.
;; To tell the difference between those two cases where the function
;; might be called, we check `delay-mode-hooks'.
-(define-derived-mode tex-mode text-mode "generic-TeX"
- (tex-common-initialization))
-;; We now move the function and define it again. This gives a warning
-;; in the byte-compiler :-( but it's difficult to avoid because
-;; `define-derived-mode' will necessarily define the function once
-;; and we need to define it a second time for `autoload' to get the
-;; proper docstring.
-(defalias 'tex-mode-internal (symbol-function 'tex-mode))
-
-;; Suppress the byte-compiler warning about multiple definitions.
-;; This is a) ugly, and b) cheating, but this was the last
-;; remaining warning from byte-compiling all of Emacs...
-(eval-when-compile
- (if (boundp 'byte-compile-function-environment)
- (setq byte-compile-function-environment
- (delq (assq 'tex-mode byte-compile-function-environment)
- byte-compile-function-environment))))
-
;;;###autoload
-(defun tex-mode ()
+(define-derived-mode tex-mode text-mode "generic-TeX"
"Major mode for editing files of input for TeX, LaTeX, or SliTeX.
+This is the shared parent mode of several submodes.
Tries to determine (by looking at the beginning of the file) whether
this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode',
-`latex-mode', or `slitex-mode', respectively. If it cannot be determined,
+`latex-mode', or `slitex-mode', accordingly. If it cannot be determined,
such as if there are no commands in the file, the value of `tex-default-mode'
says which mode to use."
- (interactive)
- (if delay-mode-hooks
- ;; We're called from one of the children already.
- (tex-mode-internal)
- (tex-guess-mode)))
+ (tex-common-initialization))
+
+(advice-add 'tex-mode :around #'tex--redirect-to-submode)
+(defun tex--redirect-to-submode (orig-fun)
+ "Redirect to one of the submodes when called directly."
+ (funcall (if delay-mode-hooks
+ ;; We're called from one of the children already.
+ orig-fun
+ (tex--guess-mode))))
;; The following three autoloaded aliases appear to conflict with
;; AUCTeX. However, even though AUCTeX uses the mixed case variants
@@ -1037,6 +1027,10 @@ says which mode to use."
;; AUCTeX to provide a fully functional user-level replacement. So
;; these aliases should remain as they are, in particular since AUCTeX
;; users are likely to use them.
+;; Note from Stef: I don't understand the above explanation, the only
+;; justification I can find to keep those confusing aliases is for those
+;; users who may have files annotated with -*- LaTeX -*- (e.g. because they
+;; received them from someone using AUCTeX).
;;;###autoload
(defalias 'TeX-mode 'tex-mode)
@@ -1252,10 +1246,10 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
("\\\\[a-zA-Z]+\\( +\\|{}\\)[a-zA-Z]*" . "")
("%" . "$"))))
;; A line containing just $$ is treated as a paragraph separator.
- (setq-local paragraph-start "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$")
+ (setq-local paragraph-start "[ \t]*$\\|[\f\\%]\\|[ \t]*\\$\\$")
;; A line starting with $$ starts a paragraph,
;; but does not separate paragraphs if it has more stuff on it.
- (setq-local paragraph-separate "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$[ \t]*$")
+ (setq-local paragraph-separate "[ \t]*$\\|[\f\\%]\\|[ \t]*\\$\\$[ \t]*$")
(setq-local add-log-current-defun-function #'tex-current-defun-name)
(setq-local comment-start "%")
(setq-local comment-add 1)
@@ -2301,9 +2295,6 @@ FILE is typically the output DVI or PDF file."
(setq uptodate nil)))))
uptodate)))
-
-(autoload 'format-spec "format-spec")
-
(defvar tex-executable-cache nil)
(defun tex-executable-exists-p (name)
"Like `executable-find' but with a cache."
@@ -3550,6 +3541,8 @@ There might be text before point."
(process-send-region tex-chktex--process (point-min) (point-max))
(process-send-eof tex-chktex--process))))
+(make-obsolete-variable 'tex-mode-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'tex-mode-load-hook)
(provide 'tex-mode)
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 438cb7798a1..b3bc634de9b 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -482,6 +482,13 @@ Subexpression 1 is what goes into the corresponding `@end' statement.")
(define-key map "\C-c\C-ce" 'texinfo-insert-@end)
(define-key map "\C-c\C-cd" 'texinfo-insert-@dfn)
(define-key map "\C-c\C-cc" 'texinfo-insert-@code)
+
+ ;; bindings for environment movement
+ (define-key map "\C-c." 'texinfo-to-environment-bounds)
+ (define-key map "\C-c\C-c\C-f" 'texinfo-next-environment-end)
+ (define-key map "\C-c\C-c\C-b" 'texinfo-previous-environment-end)
+ (define-key map "\C-c\C-c\C-n" 'texinfo-next-environment-start)
+ (define-key map "\C-c\C-c\C-p" 'texinfo-previous-environment-start)
map))
(easy-menu-define texinfo-mode-menu
@@ -958,6 +965,12 @@ to jump to the corresponding spot in the Texinfo source file."
:type 'string
:group 'texinfo)
+(defcustom texinfo-texi2dvi-options ""
+ "Command line options for `texinfo-texi2dvi-command'."
+ :type 'string
+ :group 'texinfo
+ :version "28.1")
+
(defcustom texinfo-tex-command "tex"
"Command used by `texinfo-tex-region' to run TeX on a region."
:type 'string
@@ -1002,9 +1015,10 @@ The value of `texinfo-tex-trailer' is appended to the temporary file after the r
(interactive)
(require 'tex-mode)
(let ((tex-command texinfo-texi2dvi-command)
- ;; Disable tex-start-options-string. texi2dvi would not
- ;; understand anything specified here.
- (tex-start-options-string ""))
+ (tex-start-options texinfo-texi2dvi-options)
+ ;; Disable tex-start-commands. texi2dvi would not understand
+ ;; anything specified here.
+ (tex-start-commands ""))
(tex-buffer)))
(defun texinfo-texindex ()
@@ -1065,6 +1079,70 @@ You are prompted for the job number (use a number shown by a previous
;; job-number"\n"))
(tex-recenter-output-buffer nil))
+(defun texinfo-to-environment-bounds ()
+ "Move point alternately to the start and end of a Texinfo environment.
+Do nothing when outside of an environment. This command does not
+handle nested environments."
+ (interactive)
+ (cond ((save-excursion
+ (forward-line 0)
+ (looking-at texinfo-environment-regexp))
+ (if (save-excursion
+ (forward-line 0)
+ (looking-at "^@end"))
+ (texinfo-previous-environment-start)
+ (texinfo-next-environment-end)))
+ ((save-excursion
+ (and (re-search-backward texinfo-environment-regexp nil t)
+ (not (looking-at "^@end"))))
+ (texinfo-previous-environment-start))
+ ;; Otherwise, point is outside of an environment, so do nothing.
+ ))
+
+(defun texinfo-next-environment-start ()
+ "Move forward to the beginning of a Texinfo environment."
+ (interactive)
+ (if (looking-at texinfo-environment-regexp)
+ (forward-line 1))
+ (while (and (re-search-forward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at "@end"))))
+ (if (save-excursion
+ (forward-line 0)
+ (looking-at texinfo-environment-regexp))
+ (forward-line 0)))
+
+(defun texinfo-previous-environment-start ()
+ "Move back to the beginning of the previous Texinfo environment."
+ (interactive)
+ (while (and (re-search-backward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at "@end")))))
+
+(defun texinfo-next-environment-end ()
+ "Move forward to the beginning of the next @end line of an environment."
+ (interactive)
+ (if (looking-at "^@end")
+ (forward-line 1))
+ (while (and (re-search-forward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (not (looking-at "^@end")))))
+ (if (save-excursion
+ (forward-line 0)
+ (looking-at "^@end"))
+ (forward-line 0)))
+
+(defun texinfo-previous-environment-end ()
+ "Move backward to the beginning of the next @end line of an environment."
+ (interactive)
+ (while (and (re-search-backward texinfo-environment-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (not (looking-at "@end"))))))
+
(provide 'texinfo)
;;; texinfo.el ends here
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index 25f37ffa23d..398f7fdc232 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -67,7 +67,7 @@ matching the white space). The pattern is matched case-sensitive regardless of
the value of `case-fold-search' setting."
:version "25.1"
:group 'tildify
- :type 'string
+ :type 'regexp
:safe t)
(defcustom tildify-pattern-alist ()
@@ -417,7 +417,7 @@ of a space at point. The regexp is always case sensitive, regardless of the
current `case-fold-search' setting."
:version "25.1"
:group 'tildify
- :type 'string)
+ :type 'regexp)
(defcustom tildify-space-predicates '(tildify-space-region-predicate)
"A list of predicate functions for `tildify-space' function."
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 1a15df33e50..558a3fd7368 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -258,7 +258,7 @@ E.g.:
;; Filenames
-(defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:"
+(defvar thing-at-point-file-name-chars "-@~/[:alnum:]_.${}#%,:"
"Characters allowable in filenames.")
(define-thing-chars filename thing-at-point-file-name-chars)
@@ -278,7 +278,7 @@ If nil, construct the regexp from `thing-at-point-uri-schemes'.")
"Regexp matching a URI without a scheme component.")
(defvar thing-at-point-uri-schemes
- ;; Officials from http://www.iana.org/assignments/uri-schemes.html
+ ;; Officials from https://www.iana.org/assignments/uri-schemes.html
'("aaa://" "about:" "acap://" "apt:" "bzr://" "bzr+ssh://"
"attachment:/" "chrome://" "cid:" "content://" "crid://" "cvs://"
"data:" "dav:" "dict://" "doi:" "dns:" "dtn:" "feed:" "file:/"
@@ -334,7 +334,7 @@ the bounds of a possible ill-formed URI (one lacking a scheme)."
;; may contain parentheses but may not contain spaces (RFC3986).
(let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'")
(skip-before "^[0-9a-zA-Z]")
- (skip-after ":;.,!?")
+ (skip-after ":;.,!?'")
(pt (point))
(beg (save-excursion
(skip-chars-backward allowed-chars)
diff --git a/lisp/thread.el b/lisp/thread.el
index d40d7bed538..00a0084f81f 100644
--- a/lisp/thread.el
+++ b/lisp/thread.el
@@ -43,8 +43,6 @@ An EVENT has the format
(err (cddr event)))
(message "Error %s: %S" thread err))))
-(make-obsolete 'thread-alive-p 'thread-live-p "27.1")
-
;;; The thread list buffer and list-threads command
(defcustom thread-list-refresh-seconds 0.5
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index dd259ec1ff6..3aa7ff0836b 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -30,7 +30,7 @@
;; your images, use image-dired.el
;;
;; The 'convert' program from 'ImageMagick'
-;; [URL:http://www.imagemagick.org/] is required.
+;; [URL:https://www.imagemagick.org/] is required.
;;
;; Thanks: Alex Schroeder <alex@gnu.org> for maintaining the package at some
;; time. The peoples at #emacs@freenode.net for numerous help. RMS
diff --git a/lisp/time.el b/lisp/time.el
index 44fd1a7e337..eca9a0752e4 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -1,4 +1,4 @@
-;;; time.el --- display time, load and mail indicator in mode line of Emacs
+;;; time.el --- display time, load and mail indicator in mode line of Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2020 Free Software
;; Foundation, Inc.
@@ -25,33 +25,31 @@
;; Facilities to display current time/date and a new-mail indicator
;; in the Emacs mode line. The entry point is `display-time'.
-;; Display time world in a buffer, the entry point is
-;; `display-time-world'.
+;; Use `world-clock' to display world clock in a buffer.
;;; Code:
+(eval-when-compile (require 'subr-x))
+
(defgroup display-time nil
"Display time and load in mode line of Emacs."
:group 'mode-line
:group 'mail)
-
(defcustom display-time-mail-file nil
"File name of mail inbox file, for indicating existence of new mail.
Non-nil and not a string means don't check for mail; nil means use
default, which is system-dependent, and is the same as used by Rmail."
:type '(choice (const :tag "None" none)
(const :tag "Default" nil)
- (file :format "%v"))
- :group 'display-time)
+ (file :format "%v")))
(defcustom display-time-mail-directory nil
"Name of mail inbox directory, for indicating existence of new mail.
Any nonempty regular file in the directory is regarded as newly arrived mail.
If nil, do not check a directory for arriving mail."
:type '(choice (const :tag "None" nil)
- (directory :format "%v"))
- :group 'display-time)
+ (directory :format "%v")))
(defcustom display-time-mail-function nil
"Function to call, for indicating existence of new mail.
@@ -59,8 +57,7 @@ If nil, that means use the default method: check that the file
specified by `display-time-mail-file' is nonempty or that the
directory `display-time-mail-directory' contains nonempty files."
:type '(choice (const :tag "Default" nil)
- (function))
- :group 'display-time)
+ (function)))
(defcustom display-time-default-load-average 0
"Which load average value will be shown in the mode line.
@@ -75,8 +72,7 @@ The value can be one of:
:type '(choice (const :tag "1 minute load" 0)
(const :tag "5 minutes load" 1)
(const :tag "15 minutes load" 2)
- (const :tag "None" nil))
- :group 'display-time)
+ (const :tag "None" nil)))
(defvar display-time-load-average nil
"Value of the system's load average currently shown on the mode line.
@@ -86,27 +82,23 @@ This is an internal variable; setting it has no effect.")
(defcustom display-time-load-average-threshold 0.1
"Load-average values below this value won't be shown in the mode line."
- :type 'number
- :group 'display-time)
+ :type 'number)
;;;###autoload
(defcustom display-time-day-and-date nil "\
Non-nil means \\[display-time] should display day and date as well as time."
- :type 'boolean
- :group 'display-time)
+ :type 'boolean)
(defvar display-time-timer nil)
(defcustom display-time-interval 60
"Seconds between updates of time in the mode line."
- :type 'integer
- :group 'display-time)
+ :type 'integer)
(defcustom display-time-24hr-format nil
"Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23.
A value of nil means 1 <= hh <= 12, and an AM/PM suffix is used."
- :type 'boolean
- :group 'display-time)
+ :type 'boolean)
(defvar display-time-string nil
"String used in mode lines to display a time string.
@@ -116,103 +108,12 @@ It should not be set directly, but is instead updated by the
(defcustom display-time-hook nil
"List of functions to be called when the time is updated on the mode line."
- :type 'hook
- :group 'display-time)
+ :type 'hook)
(defvar display-time-server-down-time nil
"Time when mail file's file system was recorded to be down.
If that file system seems to be up, the value is nil.")
-(defcustom zoneinfo-style-world-list
- '(("America/Los_Angeles" "Seattle")
- ("America/New_York" "New York")
- ("Europe/London" "London")
- ("Europe/Paris" "Paris")
- ("Asia/Calcutta" "Bangalore")
- ("Asia/Tokyo" "Tokyo"))
- "Alist of zoneinfo-style time zones and places for `display-time-world'.
-Each element has the form (TIMEZONE LABEL).
-TIMEZONE should be a string of the form AREA/LOCATION, where AREA is
-the name of a region -- a continent or ocean, and LOCATION is the name
-of a specific location, e.g., a city, within that region.
-LABEL is a string to display as the label of that TIMEZONE's time."
- :group 'display-time
- :type '(repeat (list string string))
- :version "23.1")
-
-(defcustom legacy-style-world-list
- '(("PST8PDT" "Seattle")
- ("EST5EDT" "New York")
- ("GMT0BST" "London")
- ("CET-1CDT" "Paris")
- ("IST-5:30" "Bangalore")
- ("JST-9" "Tokyo"))
- "Alist of traditional-style time zones and places for `display-time-world'.
-Each element has the form (TIMEZONE LABEL).
-TIMEZONE should be a string of the form:
-
- std[+|-]offset[dst[offset][,date[/time],date[/time]]]
-
-See the documentation of the TZ environment variable on your system,
-for more details about the format of TIMEZONE.
-LABEL is a string to display as the label of that TIMEZONE's time."
- :group 'display-time
- :type '(repeat (list string string))
- :version "23.1")
-
-(defcustom display-time-world-list t
- "Alist of time zones and places for `display-time-world' to display.
-Each element has the form (TIMEZONE LABEL).
-TIMEZONE should be in a format supported by your system. See the
-documentation of `zoneinfo-style-world-list' and
-`legacy-style-world-list' for two widely used formats. LABEL is
-a string to display as the label of that TIMEZONE's time.
-
-If the value is t instead of an alist, use the value of
-`zoneinfo-style-world-list' if it works on this platform, and of
-`legacy-style-world-list' otherwise."
-
- :group 'display-time
- :type '(choice (const :tag "Default" t)
- (repeat :tag "List of zones and labels"
- (list (string :tag "Zone") (string :tag "Label"))))
- :version "23.1")
-
-(defun time--display-world-list ()
- (if (listp display-time-world-list)
- display-time-world-list
- ;; Determine if zoneinfo style timezones are supported by testing that
- ;; America/New York and Europe/London return different timezones.
- (let ((nyt (format-time-string "%z" nil "America/New_York"))
- (gmt (format-time-string "%z" nil "Europe/London")))
- (if (string-equal nyt gmt)
- legacy-style-world-list
- zoneinfo-style-world-list))))
-
-(defcustom display-time-world-time-format "%A %d %B %R %Z"
- "Format of the time displayed, see `format-time-string'."
- :group 'display-time
- :type 'string
- :version "23.1")
-
-(defcustom display-time-world-buffer-name "*wclock*"
- "Name of the world clock buffer."
- :group 'display-time
- :type 'string
- :version "23.1")
-
-(defcustom display-time-world-timer-enable t
- "If non-nil, a timer will update the world clock."
- :group 'display-time
- :type 'boolean
- :version "23.1")
-
-(defcustom display-time-world-timer-second 60
- "Interval in seconds for updating the world clock."
- :group 'display-time
- :type 'integer
- :version "23.1")
-
;;;###autoload
(defun display-time ()
"Enable display of time, load level, and mail flag in mode lines.
@@ -249,14 +150,12 @@ See `display-time-use-mail-icon' and `display-time-mail-face'.")
"Non-nil means use an icon as mail indicator on a graphic display.
Otherwise use `display-time-mail-string'. The icon may consume less
of the mode line. It is specified by `display-time-mail-icon'."
- :group 'display-time
:type 'boolean)
;; Fixme: maybe default to the character if we can display Unicode.
(defcustom display-time-mail-string "Mail"
"String to use as the mail indicator in `display-time-string-forms'.
This can use the Unicode letter character if you can display it."
- :group 'display-time
:version "22.1"
:type '(choice (const "Mail")
;; Use :tag here because the Lucid menu won't display
@@ -270,8 +169,7 @@ See the function `format-time-string' for an explanation of
how to write this string. If this is nil, the defaults
depend on `display-time-day-and-date' and `display-time-24hr-format'."
:type '(choice (const :tag "Default" nil)
- string)
- :group 'display-time)
+ string))
(defcustom display-time-string-forms
'((if (and (not display-time-format) display-time-day-and-date)
@@ -325,8 +223,7 @@ For example:
(if mail \" Mail\" \"\"))
would give mode line times like `94/12/30 21:07:48 (UTC)'."
- :type '(repeat sexp)
- :group 'display-time)
+ :type '(repeat sexp))
(defun display-time-event-handler ()
(display-time-update)
@@ -387,6 +284,60 @@ Switches from the 1 to 5 to 15 minute load average, and then back to 1."
(defvar month)
(defvar dayname))
+(defun display-time-update--load ()
+ (if (null display-time-load-average)
+ ""
+ (condition-case ()
+ ;; Do not show values less than
+ ;; `display-time-load-average-threshold'.
+ (if (> (* display-time-load-average-threshold 100)
+ (nth display-time-load-average (load-average)))
+ ""
+ ;; The load average number is mysterious, so
+ ;; provide some help.
+ (let ((str (format " %03d"
+ (nth display-time-load-average
+ (load-average)))))
+ (propertize
+ (concat (substring str 0 -2) "." (substring str -2))
+ 'local-map (make-mode-line-mouse-map
+ 'mouse-2 'display-time-next-load-average)
+ 'mouse-face 'mode-line-highlight
+ 'help-echo (concat
+ "System load average for past "
+ (if (= 0 display-time-load-average)
+ "1 minute"
+ (if (= 1 display-time-load-average)
+ "5 minutes"
+ "15 minutes"))
+ "; mouse-2: next"))))
+ (error ""))))
+
+(defun display-time-update--mail ()
+ (let ((mail-spool-file (or display-time-mail-file
+ (getenv "MAIL")
+ (concat rmail-spool-directory
+ (user-login-name)))))
+ (cond
+ (display-time-mail-function
+ (funcall display-time-mail-function))
+ (display-time-mail-directory
+ (display-time-mail-check-directory))
+ ((and (stringp mail-spool-file)
+ (or (null display-time-server-down-time)
+ ;; If have been down for 20 min, try again.
+ (time-less-p 1200 (time-since
+ display-time-server-down-time))))
+ (let ((start-time (current-time)))
+ (prog1
+ (display-time-file-nonempty-p mail-spool-file)
+ ;; Record whether mail file is accessible.
+ (setq display-time-server-down-time
+ (let ((end-time (current-time)))
+ (and (time-less-p 20 (time-subtract
+ end-time start-time))
+ (float-time end-time))))))))))
+
(defun display-time-update ()
"Update the display-time info for the mode line.
However, don't redisplay right now.
@@ -394,57 +345,9 @@ However, don't redisplay right now.
This is used for things like Rmail `g' that want to force an
update which can wait for the next redisplay."
(let* ((now (current-time))
- (time (current-time-string now))
- (load (if (null display-time-load-average)
- ""
- (condition-case ()
- ;; Do not show values less than
- ;; `display-time-load-average-threshold'.
- (if (> (* display-time-load-average-threshold 100)
- (nth display-time-load-average (load-average)))
- ""
- ;; The load average number is mysterious, so
- ;; provide some help.
- (let ((str (format " %03d"
- (nth display-time-load-average
- (load-average)))))
- (propertize
- (concat (substring str 0 -2) "." (substring str -2))
- 'local-map (make-mode-line-mouse-map
- 'mouse-2 'display-time-next-load-average)
- 'mouse-face 'mode-line-highlight
- 'help-echo (concat
- "System load average for past "
- (if (= 0 display-time-load-average)
- "1 minute"
- (if (= 1 display-time-load-average)
- "5 minutes"
- "15 minutes"))
- "; mouse-2: next"))))
- (error ""))))
- (mail-spool-file (or display-time-mail-file
- (getenv "MAIL")
- (concat rmail-spool-directory
- (user-login-name))))
- (mail (cond
- (display-time-mail-function
- (funcall display-time-mail-function))
- (display-time-mail-directory
- (display-time-mail-check-directory))
- ((and (stringp mail-spool-file)
- (or (null display-time-server-down-time)
- ;; If have been down for 20 min, try again.
- (time-less-p 1200 (time-since
- display-time-server-down-time))))
- (let ((start-time (current-time)))
- (prog1
- (display-time-file-nonempty-p mail-spool-file)
- ;; Record whether mail file is accessible.
- (setq display-time-server-down-time
- (let ((end-time (current-time)))
- (and (time-less-p 20 (time-subtract
- end-time start-time))
- (float-time end-time)))))))))
+ (time (current-time-string now))
+ (load (display-time-update--load))
+ (mail (display-time-update--mail))
(24-hours (substring time 11 13))
(hour (string-to-number 24-hours))
(12-hours (int-to-string (1+ (% (+ hour 11) 12))))
@@ -508,13 +411,130 @@ runs the normal hook `display-time-hook' after each update."
(remove-hook 'rmail-after-get-new-mail-hook
'display-time-event-handler)))
+
+;;; Obsolete names
+
+(define-obsolete-variable-alias 'display-time-world-list
+ 'world-clock-list "28.1")
+(define-obsolete-variable-alias 'display-time-world-time-format
+ 'world-clock-time-format "28.1")
+(define-obsolete-variable-alias 'display-time-world-buffer-name
+ 'world-clock-buffer-name "28.1")
+(define-obsolete-variable-alias 'display-time-world-timer-enable
+ 'world-clock-timer-enable "28.1")
+(define-obsolete-variable-alias 'display-time-world-timer-second
+ 'world-clock-timer-second "28.1")
+
+(define-obsolete-function-alias 'display-time-world-mode
+ #'world-clock-mode "28.1")
+(define-obsolete-function-alias 'display-time-world-display
+ #'world-clock-display "28.1")
+(define-obsolete-function-alias 'display-time-world-timer
+ #'world-clock-update "28.1")
+
+
+;;; World clock
+
+(defgroup world-clock nil
+ "Display a world clock."
+ :group 'display-time)
-(define-derived-mode display-time-world-mode special-mode "World clock"
+(defcustom zoneinfo-style-world-list
+ '(("America/Los_Angeles" "Seattle")
+ ("America/New_York" "New York")
+ ("Europe/London" "London")
+ ("Europe/Paris" "Paris")
+ ("Asia/Calcutta" "Bangalore")
+ ("Asia/Tokyo" "Tokyo"))
+ "Alist of zoneinfo-style time zones and places for `world-clock'.
+Each element has the form (TIMEZONE LABEL).
+TIMEZONE should be a string of the form AREA/LOCATION, where AREA is
+the name of a region -- a continent or ocean, and LOCATION is the name
+of a specific location, e.g., a city, within that region.
+LABEL is a string to display as the label of that TIMEZONE's time."
+ :type '(repeat (list string string))
+ :version "23.1")
+
+(defcustom legacy-style-world-list
+ '(("PST8PDT" "Seattle")
+ ("EST5EDT" "New York")
+ ("GMT0BST" "London")
+ ("CET-1CDT" "Paris")
+ ("IST-5:30" "Bangalore")
+ ("JST-9" "Tokyo"))
+ "Alist of traditional-style time zones and places for `world-clock'.
+Each element has the form (TIMEZONE LABEL).
+TIMEZONE should be a string of the form:
+
+ std[+|-]offset[dst[offset][,date[/time],date[/time]]]
+
+See the documentation of the TZ environment variable on your system,
+for more details about the format of TIMEZONE.
+LABEL is a string to display as the label of that TIMEZONE's time."
+ :type '(repeat (list string string))
+ :version "23.1")
+
+(defcustom world-clock-list t
+ "Alist of time zones and places for `world-clock' to display.
+Each element has the form (TIMEZONE LABEL).
+TIMEZONE should be in a format supported by your system. See the
+documentation of `zoneinfo-style-world-list' and
+`legacy-style-world-list' for two widely used formats. LABEL is
+a string to display as the label of that TIMEZONE's time.
+
+If the value is t instead of an alist, use the value of
+`zoneinfo-style-world-list' if it works on this platform, and of
+`legacy-style-world-list' otherwise."
+ :type '(choice (const :tag "Default" t)
+ (repeat :tag "List of zones and labels"
+ (list (string :tag "Zone") (string :tag "Label"))))
+ :version "28.1")
+
+(defun time--display-world-list ()
+ (if (listp world-clock-list)
+ world-clock-list
+ ;; Determine if zoneinfo style timezones are supported by testing that
+ ;; America/New York and Europe/London return different timezones.
+ (let ((nyt (format-time-string "%z" nil "America/New_York"))
+ (gmt (format-time-string "%z" nil "Europe/London")))
+ (if (string-equal nyt gmt)
+ legacy-style-world-list
+ zoneinfo-style-world-list))))
+
+(defcustom world-clock-time-format "%A %d %B %R %Z"
+ "Time format for `world-clock', see `format-time-string'."
+ :type 'string
+ :version "28.1")
+
+(defcustom world-clock-buffer-name "*wclock*"
+ "Name of the `world-clock' buffer."
+ :type 'string
+ :version "28.1")
+
+(defcustom world-clock-timer-enable t
+ "If non-nil, a timer will update the `world-clock' buffer."
+ :type 'boolean
+ :version "28.1")
+
+(defcustom world-clock-timer-second 60
+ "Interval in seconds for updating the `world-clock' buffer."
+ :type 'integer
+ :version "28.1")
+
+(defface world-clock-label
+ '((t :inherit font-lock-variable-name-face))
+ "Face for time zone label in `world-clock' buffer.")
+
+(define-derived-mode world-clock-mode special-mode "World clock"
"Major mode for buffer that displays times in various time zones.
-See `display-time-world'."
+See `world-clock'."
+ (setq-local revert-buffer-function #'world-clock-update)
(setq show-trailing-whitespace nil))
-(defun display-time-world-display (alist)
+(defvar world-clock--timer nil
+ "The current world clock timer.")
+
+(defun world-clock-display (alist)
"Replace current buffer text with times in various zones, based on ALIST."
(let ((inhibit-read-only t)
(buffer-undo-list t)
@@ -526,58 +546,72 @@ See `display-time-world'."
(let* ((label (cadr zone))
(width (string-width label)))
(push (cons label
- (format-time-string display-time-world-time-format
+ (format-time-string world-clock-time-format
now (car zone)))
result)
(when (> width max-width)
(setq max-width width))))
(setq fmt (concat "%-" (int-to-string max-width) "s %s\n"))
(dolist (timedata (nreverse result))
- (insert (format fmt (car timedata) (cdr timedata))))
+ (insert (format fmt
+ (propertize (car timedata)
+ 'face 'world-clock-label)
+ (cdr timedata))))
(delete-char -1))
(goto-char (point-min)))
;;;###autoload
-(defun display-time-world ()
- "Enable updating display of times in various time zones.
-`display-time-world-list' specifies the zones.
-To turn off the world time display, go to that window and type `q'."
+(define-obsolete-function-alias 'display-time-world
+ #'world-clock "28.1")
+
+;;;###autoload
+(defun world-clock ()
+ "Display a world clock buffer with times in various time zones.
+The variable `world-clock-list' specifies which time zones to use.
+To turn off the world time display, go to the window and type `\\[quit-window]'."
(interactive)
- (when (and display-time-world-timer-enable
- (not (get-buffer display-time-world-buffer-name)))
- (run-at-time t display-time-world-timer-second 'display-time-world-timer))
- (with-current-buffer (get-buffer-create display-time-world-buffer-name)
- (display-time-world-display (time--display-world-list))
- (display-buffer display-time-world-buffer-name
- (cons nil '((window-height . fit-window-to-buffer))))
- (display-time-world-mode)))
-
-(defun display-time-world-timer ()
- (if (get-buffer display-time-world-buffer-name)
- (with-current-buffer (get-buffer display-time-world-buffer-name)
- (display-time-world-display (time--display-world-list)))
- ;; cancel timer
- (let ((list timer-list))
- (while list
- (let ((elt (pop list)))
- (when (equal (symbol-name (timer--function elt))
- "display-time-world-timer")
- (cancel-timer elt)))))))
+ (if-let ((buffer (get-buffer world-clock-buffer-name)))
+ (pop-to-buffer buffer)
+ (pop-to-buffer world-clock-buffer-name)
+ (when world-clock-timer-enable
+ (setq world-clock--timer
+ (run-at-time t world-clock-timer-second #'world-clock-update))
+ (add-hook 'kill-buffer-hook #'world-clock-cancel-timer nil t)))
+ (world-clock-display (time--display-world-list))
+ (world-clock-mode)
+ (fit-window-to-buffer))
+
+(defun world-clock-cancel-timer ()
+ "Cancel the world clock timer."
+ (when world-clock--timer
+ (cancel-timer world-clock--timer)
+ (setq world-clock--timer nil)))
+
+(defun world-clock-update (&optional _arg _noconfirm)
+ "Update the `world-clock' buffer."
+ (if (get-buffer world-clock-buffer-name)
+ (with-current-buffer (get-buffer world-clock-buffer-name)
+ (world-clock-display (time--display-world-list)))
+ (world-clock-cancel-timer)))
;;;###autoload
-(defun emacs-uptime (&optional format)
+(defun emacs-uptime (&optional format here)
"Return a string giving the uptime of this instance of Emacs.
FORMAT is a string to format the result, using `format-seconds'.
-For example, the Unix uptime command format is \"%D, %z%2h:%.2m\"."
- (interactive)
+For example, the Unix uptime command format is \"%D, %z%2h:%.2m\".
+If the optional argument HERE is non-nil, insert string at
+point."
+ (interactive "i\nP")
(let ((str
(format-seconds (or format "%Y, %D, %H, %M, %z%S")
(time-convert
(time-since before-init-time)
'integer))))
- (if (called-interactively-p 'interactive)
- (message "%s" str)
- str)))
+ (if here
+ (insert str)
+ (if (called-interactively-p 'interactive)
+ (message "%s" str)
+ str))))
;;;###autoload
(defun emacs-init-time ()
diff --git a/lisp/tmm.el b/lisp/tmm.el
index e9f3f5b038f..4c2855751c2 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -42,25 +42,7 @@
(defvar tmm-next-shortcut-digit)
(defvar tmm-table-undef)
-(defun tmm-menubar-keymap ()
- "Return the current menu-bar keymap.
-
-The ordering of the return value respects `menu-bar-final-items'."
- (let ((menu-bar '())
- (menu-end '()))
- (map-keymap
- (lambda (key binding)
- (push (cons key binding)
- ;; If KEY is the name of an item that we want to put last,
- ;; move it to the end.
- (if (memq key menu-bar-final-items)
- menu-end
- menu-bar)))
- (tmm-get-keybind [menu-bar]))
- `(keymap ,@(nreverse menu-bar) ,@(nreverse menu-end))))
-
;;;###autoload (define-key global-map "\M-`" 'tmm-menubar)
-;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse)
;;;###autoload
(defun tmm-menubar (&optional x-position)
@@ -74,30 +56,12 @@ to invoke `tmm-menubar' instead, customize the variable
`tty-menu-open-use-tmm' to a non-nil value."
(interactive)
(run-hooks 'menu-bar-update-hook)
- ;; Obey menu-bar-final-items; put those items last.
- (let ((menu-bar (tmm-menubar-keymap))
- menu-bar-item)
- (if x-position
- (let ((column 0)
- prev-key)
- (catch 'done
- (map-keymap
- (lambda (key binding)
- (when (> column x-position)
- (setq menu-bar-item prev-key)
- (throw 'done nil))
- (setq prev-key key)
- (pcase binding
- ((or `(,(and (pred stringp) name) . ,_) ;Simple menu item.
- `(menu-item ,name ,_cmd ;Extended menu item.
- . ,(and props
- (guard (let ((visible
- (plist-get props :visible)))
- (or (null visible)
- (eval visible)))))))
- (setq column (+ column (length name) 1)))))
- menu-bar))))
- (tmm-prompt menu-bar nil menu-bar-item)))
+ (let ((menu-bar (menu-bar-keymap))
+ (menu-bar-item-cons (and x-position
+ (menu-bar-item-at-x x-position))))
+ (tmm-prompt menu-bar
+ nil
+ (and menu-bar-item-cons (car menu-bar-item-cons)))))
;;;###autoload
(defun tmm-menubar-mouse (event)
@@ -517,14 +481,6 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
(or (assoc str tmm-km-list)
(push (cons str (cons event km)) tmm-km-list))))))
-(defun tmm-get-keybind (keyseq)
- "Return the current binding of KEYSEQ, merging prefix definitions.
-If KEYSEQ is a prefix key that has local and global bindings,
-we merge them into a single keymap which shows the proper order of the menu.
-However, for the menu bar itself, the value does not take account
-of `menu-bar-final-items'."
- (lookup-key (cons 'keymap (nreverse (current-active-maps))) keyseq))
-
(provide 'tmm)
;;; tmm.el ends here
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 7df1e28e06f..84562164300 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -1,4 +1,4 @@
-;;; tool-bar.el --- setting up the tool bar
+;;; tool-bar.el --- setting up the tool bar -*- lexical-binding: t -*-
;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
@@ -139,7 +139,7 @@ ICON.xbm, using `find-image'.
Use this function only to make bindings in the global value of `tool-bar-map'.
To define items in any other map, use `tool-bar-local-item'."
- (apply 'tool-bar-local-item icon def key tool-bar-map props))
+ (apply #'tool-bar-local-item icon def key tool-bar-map props))
(defun tool-bar--image-expression (icon)
"Return an expression that evaluates to an image spec for ICON."
@@ -191,7 +191,7 @@ MAP must contain appropriate binding for `[menu-bar]' which holds a keymap.
Use this function only to make bindings in the global value of `tool-bar-map'.
To define items in any other map, use `tool-bar-local-item-from-menu'."
- (apply 'tool-bar-local-item-from-menu command icon
+ (apply #'tool-bar-local-item-from-menu command icon
(default-value 'tool-bar-map) map props))
;;;###autoload
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index f35f6b9a03e..ffc3d499e30 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -1,4 +1,4 @@
-;;; tooltip.el --- show tooltip windows
+;;; tooltip.el --- show tooltip windows -*- lexical-binding:t -*-
;; Copyright (C) 1997, 1999-2020 Free Software Foundation, Inc.
@@ -70,24 +70,20 @@ echo area, instead of making a pop-up window."
(defcustom tooltip-delay 0.7
"Seconds to wait before displaying a tooltip the first time."
- :type 'number
- :group 'tooltip)
+ :type 'number)
(defcustom tooltip-short-delay 0.1
"Seconds to wait between subsequent tooltips on different items."
- :type 'number
- :group 'tooltip)
+ :type 'number)
(defcustom tooltip-recent-seconds 1
"Display tooltips if changing tip items within this many seconds.
Do so after `tooltip-short-delay'."
- :type 'number
- :group 'tooltip)
+ :type 'number)
(defcustom tooltip-hide-delay 10
"Hide tooltips automatically after this many seconds."
- :type 'number
- :group 'tooltip)
+ :type 'number)
(defcustom tooltip-x-offset 5
"X offset, in pixels, for the display of tooltips.
@@ -98,8 +94,7 @@ interfere with clicking where you wish.
If `tooltip-frame-parameters' includes the `left' parameter,
the value of `tooltip-x-offset' is ignored."
- :type 'integer
- :group 'tooltip)
+ :type 'integer)
(defcustom tooltip-y-offset +20
"Y offset, in pixels, for the display of tooltips.
@@ -110,8 +105,7 @@ interfere with clicking where you wish.
If `tooltip-frame-parameters' includes the `top' parameter,
the value of `tooltip-y-offset' is ignored."
- :type 'integer
- :group 'tooltip)
+ :type 'integer)
(defcustom tooltip-frame-parameters
'((name . "tooltip")
@@ -127,8 +121,7 @@ Note that font and color parameters are ignored, and the attributes
of the `tooltip' face are used instead."
:type '(repeat (cons :format "%v"
(symbol :tag "Parameter")
- (sexp :tag "Value")))
- :group 'tooltip
+ (sexp :tag "Value")))
:version "26.1")
(defface tooltip
@@ -139,15 +132,13 @@ of the `tooltip' face are used instead."
(t
:inherit variable-pitch))
"Face for tooltips."
- :group 'tooltip
:group 'basic-faces)
(defcustom tooltip-use-echo-area nil
"Use the echo area instead of tooltip frames for help and GUD tooltips.
This variable is obsolete; instead of setting it to t, disable
`tooltip-mode' (which has a similar effect)."
- :type 'boolean
- :group 'tooltip)
+ :type 'boolean)
(make-obsolete-variable 'tooltip-use-echo-area
"disable Tooltip mode instead" "24.1" 'set)
@@ -161,14 +152,11 @@ the echo area is resized as needed to accommodate the full text
of the tooltip.
This variable has effect only on GUI frames."
:type 'boolean
- :group 'tooltip
:version "27.1")
;;; Variables that are not customizable.
-(define-obsolete-variable-alias 'tooltip-hook 'tooltip-functions "23.1")
-
(defvar tooltip-functions nil
"Functions to call to display tooltips.
Each function is called with one argument EVENT which is a copy
diff --git a/lisp/type-break.el b/lisp/type-break.el
index 5877292bab0..a9ec19b2565 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -51,8 +51,6 @@
;; this, but I think the health of my hands is far more important than a
;; few pages of virtual memory.
-;; This program has no hope of working in Emacs 18.
-
;; This package was inspired by Roland McGrath's hanoi-break.el.
;; Several people contributed feedback and ideas, including
;; Roland McGrath <roland@gnu.org>
@@ -958,11 +956,7 @@ FRAC should be the inverse of the fractional value; for example, a value of
sum))
(defun type-break-time-stamp (&optional when)
- (if (fboundp 'format-time-string)
- (format-time-string type-break-time-stamp-format when)
- ;; Emacs 19.28 and prior do not have format-time-string.
- ;; In that case, result is not customizable. Upgrade today!
- (format "[%s] " (substring (current-time-string when) 11 16))))
+ (format-time-string type-break-time-stamp-format when))
(defun type-break-format-time (secs)
(let ((mins (/ secs 60)))
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 70e8ecee745..e6a1b35bc06 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -104,6 +104,14 @@ would have the following buffer names in the various styles:
post-forward-angle-brackets name<bar/mumble> name<quux/mumble>
nil name name<2>
+The value can be set to a customized function with two arguments
+BASE and EXTRA-STRINGS where BASE is a string and EXTRA-STRINGS
+is a list of strings. For example the current implementation for
+post-forward-angle-brackets could be:
+
+(defun my-post-forward-angle-brackets (base extra-string)
+ (concat base \"<\" (mapconcat #'identity extra-string \"/\") \">\"))
+
The \"mumble\" part may be stripped as well, depending on the
setting of `uniquify-strip-common-suffix'. For more options that
you can set, browse the `uniquify' custom group."
@@ -111,6 +119,7 @@ you can set, browse the `uniquify' custom group."
(const reverse)
(const post-forward)
(const post-forward-angle-brackets)
+ (function :tag "Other")
(const :tag "numeric suffixes" nil))
:version "24.4"
:require 'uniquify)
@@ -364,20 +373,22 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
(cond
((null extra-string) base)
((string-equal base "") ;Happens for dired buffers on the root directory.
- (mapconcat 'identity extra-string "/"))
+ (mapconcat #'identity extra-string "/"))
((eq uniquify-buffer-name-style 'reverse)
- (mapconcat 'identity
+ (mapconcat #'identity
(cons base (nreverse extra-string))
(or uniquify-separator "\\")))
((eq uniquify-buffer-name-style 'forward)
- (mapconcat 'identity (nconc extra-string (list base))
+ (mapconcat #'identity (nconc extra-string (list base))
"/"))
((eq uniquify-buffer-name-style 'post-forward)
(concat base (or uniquify-separator "|")
- (mapconcat 'identity extra-string "/")))
+ (mapconcat #'identity extra-string "/")))
((eq uniquify-buffer-name-style 'post-forward-angle-brackets)
- (concat base "<" (mapconcat 'identity extra-string "/")
+ (concat base "<" (mapconcat #'identity extra-string "/")
">"))
+ ((functionp uniquify-buffer-name-style)
+ (funcall uniquify-buffer-name-style base extra-string))
(t (error "Bad value for uniquify-buffer-name-style: %s"
uniquify-buffer-name-style)))))
diff --git a/lisp/url/ChangeLog.1 b/lisp/url/ChangeLog.1
index cf168ebf470..0309440defa 100644
--- a/lisp/url/ChangeLog.1
+++ b/lisp/url/ChangeLog.1
@@ -449,7 +449,7 @@
2012-04-10 William Xu <william.xwl@gmail.com> (tiny change)
- * url.el (url-retrieve-internal): Hexify multibye URL string first
+ * url.el (url-retrieve-internal): Hexify multibyte URL string first
when necessary (bug#7017).
2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el
index dde47e94de5..5fe817cc0e8 100644
--- a/lisp/url/url-about.el
+++ b/lisp/url/url-about.el
@@ -51,7 +51,7 @@
" <title>Supported Protocols</title>\n"
" </head>\n"
" <body>\n"
- " <h1>Supported Protocols - URL v" url-version "</h1>\n"
+ " <h1>Supported Protocols - URL package in Emacs " emacs-version "</h1>\n"
" <table width='100%' border='1'>\n"
" <tr>\n"
" <td>Protocol\n"
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index f2044617b94..fd800cd9782 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -39,7 +39,7 @@
;;; ------------------------
;;; This implements the BASIC authorization type. See the online
;;; documentation at
-;;; http://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html
+;;; https://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html
;;; for the complete documentation on this type.
;;;
;;; This is very insecure, but it works as a proof-of-concept
@@ -494,21 +494,19 @@ PROMPT is boolean - specifies whether to ask the user for a username/password
(car-safe
(sort
(mapcar
- (function
- (lambda (scheme)
- (if (fboundp (car (cdr scheme)))
- (cons (cdr (cdr scheme))
- (funcall (car (cdr scheme)) url nil nil realm))
- (cons 0 nil))))
+ (lambda (scheme)
+ (if (fboundp (car (cdr scheme)))
+ (cons (cdr (cdr scheme))
+ (funcall (car (cdr scheme)) url nil nil realm))
+ (cons 0 nil)))
url-registered-auth-schemes)
- (function
- (lambda (x y)
- (cond
- ((null (cdr x)) nil)
- ((and (cdr x) (null (cdr y))) t)
- ((and (cdr x) (cdr y))
- (>= (car x) (car y)))
- (t nil)))))))
+ (lambda (x y)
+ (cond
+ ((null (cdr x)) nil)
+ ((and (cdr x) (null (cdr y))) t)
+ ((and (cdr x) (cdr y))
+ (>= (car x) (car y)))
+ (t nil))))))
(if (symbolp type) (setq type (symbol-name type)))
(let* ((scheme (car-safe
(cdr-safe (assoc (downcase type)
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index a67e5dcd125..ea14e60ecc8 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -110,23 +110,22 @@ The actual return value is the last modification time of the cache file."
(let ((slash nil))
(setq fname
(mapconcat
- (function
- (lambda (x)
- (cond
- ((and (= ?/ x) slash)
- (setq slash nil)
- "%2F")
- ((= ?/ x)
- (setq slash t)
- "/")
- (t
- (setq slash nil)
- (char-to-string x))))) fname ""))))
+ (lambda (x)
+ (cond
+ ((and (= ?/ x) slash)
+ (setq slash nil)
+ "%2F")
+ ((= ?/ x)
+ (setq slash t)
+ "/")
+ (t
+ (setq slash nil)
+ (char-to-string x)))) fname ""))))
(setq fname (and fname
(mapconcat
- (function (lambda (x)
- (if (= x ?~) "" (char-to-string x))))
+ (lambda (x)
+ (if (= x ?~) "" (char-to-string x)))
fname ""))
fname (cond
((null fname) nil)
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el
index ba68fe100e5..fa75a0a6bb9 100644
--- a/lisp/url/url-dired.el
+++ b/lisp/url/url-dired.el
@@ -1,4 +1,4 @@
-;;; url-dired.el --- URL Dired minor mode
+;;; url-dired.el --- URL Dired minor mode -*- lexical-binding: t -*-
;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
diff --git a/lisp/url/url-domsuf.el b/lisp/url/url-domsuf.el
index fa57815e204..c1cdf901d6c 100644
--- a/lisp/url/url-domsuf.el
+++ b/lisp/url/url-domsuf.el
@@ -1,4 +1,4 @@
-;;; url-domsuf.el --- Say what domain names can have cookies set.
+;;; url-domsuf.el --- Say what domain names can have cookies set. -*- lexical-binding:t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
@@ -24,7 +24,7 @@
;;; Commentary:
;; The rules for what domains can have cookies set is defined here:
-;; http://publicsuffix.org/list/
+;; https://publicsuffix.org/list/
;;; Code:
@@ -87,17 +87,6 @@
(setq allowedp nil))))
allowedp))
-;; Tests:
-
-;; TODO convert to a proper test.
-;; (url-domsuf-cookie-allowed-p "com") => nil
-;; (url-domsuf-cookie-allowed-p "foo.bar.bd") => t
-;; (url-domsuf-cookie-allowed-p "bar.bd") => nil
-;; (url-domsuf-cookie-allowed-p "co.uk") => nil
-;; (url-domsuf-cookie-allowed-p "foo.bar.hokkaido.jo") => t
-;; (url-domsuf-cookie-allowed-p "bar.yokohama.jp") => nil
-;; (url-domsuf-cookie-allowed-p "city.yokohama.jp") => t
-
(provide 'url-domsuf)
;;; url-domsuf.el ends here
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index 47964b081f4..9f52f2586f4 100644
--- a/lisp/url/url-expand.el
+++ b/lisp/url/url-expand.el
@@ -65,10 +65,10 @@ path components followed by `..' are removed, along with the `..' itself."
(if (and url (not (string-match "^#" url)))
;; Need to nuke newlines and spaces in the URL, or we open
;; ourselves up to potential security holes.
- (setq url (mapconcat (function (lambda (x)
- (if (memq x '(? ?\n ?\r))
- ""
- (char-to-string x))))
+ (setq url (mapconcat (lambda (x)
+ (if (memq x '(? ?\n ?\r))
+ ""
+ (char-to-string x)))
url "")))
;; Need to figure out how/where to expand the fragment relative to
@@ -92,12 +92,19 @@ path components followed by `..' are removed, along with the `..' itself."
(cond
((= (length url) 0) ; nil or empty string
(url-recreate-url default))
- ((string-match url-nonrelative-link url) ; Fully-qualified URL, return it immediately
+ ((string-match url-nonrelative-link url) ; Fully-qualified URL,
+ ; return it immediately
url)
(t
(let* ((urlobj (url-generic-parse-url url))
(inhibit-file-name-handlers t)
- (expander (url-scheme-get-property (url-type default) 'expand-file-name)))
+ (expander (if (url-type default)
+ (url-scheme-get-property (url-type default)
+ 'expand-file-name)
+ ;; If neither the default nor the URL to be
+ ;; expanded have a protocol, then just use the
+ ;; identity expander as a fallback.
+ 'url-identity-expander)))
(if (string-match "^//" url)
(setq urlobj (url-generic-parse-url (concat (url-type default) ":"
url))))
@@ -113,7 +120,7 @@ path components followed by `..' are removed, along with the `..' itself."
;; Well, they told us the scheme, let's just go with it.
nil
(setf (url-type urlobj) (or (url-type urlobj) (url-type defobj)))
- (setf (url-port urlobj) (or (url-portspec urlobj)
+ (setf (url-portspec urlobj) (or (url-portspec urlobj)
(and (string= (url-type urlobj)
(url-type defobj))
(url-port defobj))))
diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el
index a436a431db0..50b21bd8d44 100644
--- a/lisp/url/url-ftp.el
+++ b/lisp/url/url-ftp.el
@@ -1,4 +1,4 @@
-;;; url-ftp.el --- FTP wrapper
+;;; url-ftp.el --- FTP wrapper -*- lexical-binding: t -*-
;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index bcb67431aa8..f16fc234025 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -191,7 +191,7 @@ linked Emacs under SunOS 4.x."
proc (concat (mapconcat 'identity
(append url-gateway-telnet-parameters
(list host service)) " ") "\n"))
- (url-wait-for-string "^\r*Escape character.*\r*\n+" proc)
+ (url-wait-for-string "^\r*Escape character.*\n+" proc)
(delete-region (point-min) (match-end 0))
(process-send-string proc "\^]\n")
(url-wait-for-string "^telnet" proc)
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 331152808fd..1c3607bb661 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -339,8 +339,7 @@ if it had been inserted from a file named URL."
(decode-coding-inserted-region (point-min) (point) url
visit beg end replace))
(let ((inserted (car size-and-charset)))
- (list url (or (and (fboundp 'after-insert-file-set-coding)
- (after-insert-file-set-coding inserted visit))
+ (list url (or (after-insert-file-set-coding inserted visit)
inserted))))))
;;;###autoload
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 55953c83c04..8532da1d1fb 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -225,7 +225,7 @@ request.")
(os-info (unless (and (listp url-privacy-level)
(memq 'os url-privacy-level))
(format "(%s; %s)" url-system-type url-os-type)))
- (url-info (format "URL/%s" url-version)))
+ (url-info (format "URL/Emacs")))
(string-join (delq nil (list package-info url-info
emacs-info os-info))
" ")))
@@ -702,15 +702,7 @@ should be shown to the user."
;; Treat everything like '300'
nil))
(when redirect-uri
- ;; Clean off any whitespace and/or <...> cruft.
- (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri)
- (setq redirect-uri (match-string 1 redirect-uri)))
- (if (string-match "^<\\(.*\\)>$" redirect-uri)
- (setq redirect-uri (match-string 1 redirect-uri)))
-
- ;; Some stupid sites (like sourceforge) send a
- ;; non-fully-qualified URL (ie: /), which royally confuses
- ;; the URL library.
+ ;; Handle relative redirect URIs.
(if (not (string-match url-nonrelative-link redirect-uri))
;; Be careful to use the real target URL, otherwise we may
;; compute the redirection relative to the URL of the proxy.
@@ -1404,13 +1396,22 @@ The return value of this function is the retrieval buffer."
(defun url-https-proxy-connect (connection)
(setq url-http-after-change-function 'url-https-proxy-after-change-function)
- (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n"
- "Host: %s\r\n"
- "\r\n")
- (url-host url-current-object)
- (or (url-port url-current-object)
- url-https-default-port)
- (url-host url-current-object))))
+ (process-send-string
+ connection
+ (format
+ (concat "CONNECT %s:%d HTTP/1.1\r\n"
+ "Host: %s\r\n"
+ (let ((proxy-auth (let ((url-basic-auth-storage
+ 'url-http-proxy-basic-auth-storage))
+ (url-get-authentication url-http-proxy nil
+ 'any nil))))
+ (and proxy-auth
+ (concat "Proxy-Authorization: " proxy-auth "\r\n")))
+ "\r\n")
+ (url-host url-current-object)
+ (or (url-port url-current-object)
+ url-https-default-port)
+ (url-host url-current-object))))
(defun url-https-proxy-after-change-function (_st _nd _length)
(let* ((process-buffer (current-buffer))
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 03a3b37f398..3ff6e647478 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -1,4 +1,4 @@
-;;; url-irc.el --- IRC URL interface
+;;; url-irc.el --- IRC URL interface -*- lexical-binding: t -*-
;; Copyright (C) 1996-1999, 2004-2020 Free Software Foundation, Inc.
@@ -22,7 +22,7 @@
;;; Commentary:
;; IRC URLs are defined in
-;; http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
+;; https://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
;;; Code:
@@ -48,6 +48,8 @@ PASSWORD - What password to use"
;; External.
(declare-function zenirc "ext:zenirc" (&optional prefix))
(declare-function zenirc-send-line "ext:zenirc" ())
+(defvar zenirc-server-alist)
+(defvar zenirc-buffer-name)
(defun url-irc-zenirc (host port channel user password)
(let ((zenirc-buffer-name (if (and user host port)
@@ -65,7 +67,7 @@ PASSWORD - What password to use"
(defun url-irc-rcirc (host port channel user password)
(let ((chan (when channel (concat "#" channel))))
- (rcirc-connect host port user nil nil (when chan (list chan)))
+ (rcirc-connect host port user nil nil (when chan (list chan)) password)
(when chan
(switch-to-buffer (concat chan "@" host)))))
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index d47eb02db68..9ef17cccd77 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -75,7 +75,7 @@
" </div>\n"
" </body>\n"
"</html>\n"
- "<!-- Automatically generated by URL v" url-version " -->\n"
+ "<!-- Automatically generated by URL in Emacs " emacs-version " -->\n"
)))
buf))
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index ff18cf1fe40..46cdff0f724 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -123,17 +123,24 @@ The variable `url-queue-timeout' sets a timeout."
(setq url-queue-progress-timer nil))))
(defun url-queue-callback-function (status job)
- (setq url-queue (delq job url-queue))
- (when (and (eq (car status) :error)
- (eq (cadr (cadr status)) 'connection-failed))
- ;; If we get a connection error, then flush all other jobs from
- ;; the host from the queue. This particularly makes sense if the
- ;; error really is a DNS resolver issue, which happens
- ;; synchronously and totally halts Emacs.
- (url-queue-remove-jobs-from-host
- (plist-get (nthcdr 3 (cadr status)) :host)))
- (url-queue-run-queue)
- (apply (url-queue-callback job) (cons status (url-queue-cbargs job))))
+ (let ((buffer (current-buffer)))
+ (setq url-queue (delq job url-queue))
+ (when (and (eq (car status) :error)
+ (eq (cadr (cadr status)) 'connection-failed))
+ ;; If we get a connection error, then flush all other jobs from
+ ;; the host from the queue. This particularly makes sense if the
+ ;; error really is a DNS resolver issue, which happens
+ ;; synchronously and totally halts Emacs.
+ (url-queue-remove-jobs-from-host
+ (plist-get (nthcdr 3 (cadr status)) :host)))
+ (url-queue-run-queue)
+ ;; Somehow something deep in the bowels in the URL library may
+ ;; have killed off the current buffer. So check that it's still
+ ;; alive before doing anything, and if not, just create a dummy
+ ;; buffer and do the callback anyway.
+ (unless (buffer-live-p buffer)
+ (set-buffer (generate-new-buffer " *temp*")))
+ (apply (url-queue-callback job) (cons status (url-queue-cbargs job)))))
(defun url-queue-remove-jobs-from-host (host)
(let ((jobs nil))
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 645011a5783..0a7e7e205e0 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -569,31 +569,6 @@ Has a preference for looking backward when not directly on a symbol."
(setq url nil))
url)))
-(defun url-generate-unique-filename (&optional fmt)
- "Generate a unique filename in `url-temporary-directory'."
- (declare (obsolete make-temp-file "23.1"))
- ;; This variable is obsolete, but so is this function.
- (let ((tempdir (with-no-warnings url-temporary-directory)))
- (if (not fmt)
- (let ((base (format "url-tmp.%d" (user-real-uid)))
- (fname "")
- (x 0))
- (setq fname (format "%s%d" base x))
- (while (file-exists-p
- (expand-file-name fname tempdir))
- (setq x (1+ x)
- fname (concat base (int-to-string x))))
- (expand-file-name fname tempdir))
- (let ((base (concat "url" (int-to-string (user-real-uid))))
- (fname "")
- (x 0))
- (setq fname (format fmt (concat base (int-to-string x))))
- (while (file-exists-p
- (expand-file-name fname tempdir))
- (setq x (1+ x)
- fname (format fmt (concat base (int-to-string x)))))
- (expand-file-name fname tempdir)))))
-
(defun url-extract-mime-headers ()
"Set `url-current-mime-headers' in current buffer."
(save-excursion
@@ -615,9 +590,7 @@ Creates FILE and its parent directories if they do not exist."
(with-temp-buffer
(write-region (point-min) (point-max) file nil 'silent nil 'excl)))
(file-already-exists
- (if (file-symlink-p file)
- (error "Danger: `%s' is a symbolic link" file))
- (set-file-modes file #o0600))))
+ (set-file-modes file #o0600 'nofollow))))
(autoload 'puny-encode-domain "puny")
(autoload 'url-domsuf-cookie-allowed-p "url-domsuf")
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 82617b76a71..f9dce2418f6 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -1,4 +1,4 @@
-;;; url-vars.el --- Variables for Uniform Resource Locator tool
+;;; url-vars.el --- Variables for Uniform Resource Locator tool -*- lexical-binding:t -*-
;; Copyright (C) 1996-1999, 2001, 2004-2020 Free Software Foundation,
;; Inc.
@@ -24,6 +24,7 @@
(defconst url-version "Emacs"
"Version number of URL package.")
+(make-obsolete-variable 'url-version nil "28.1")
(defgroup url nil
"Uniform Resource Locator tool."
@@ -311,13 +312,6 @@ Applies when a protected document is denied by the server."
:type 'integer
:group 'url)
-(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp")
- "Where temporary files go."
- :type 'directory
- :group 'url-file)
-(make-obsolete-variable 'url-temporary-directory
- 'temporary-file-directory "23.1")
-
(defcustom url-show-status t
"Whether to show a running total of bytes transferred.
Can cause a large hit if using a remote X display over a slow link, or
@@ -430,6 +424,8 @@ Should be one of:
"Hook run after initializing the URL library."
:group 'url
:type 'hook)
+(make-obsolete-variable 'url-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defconst url-working-buffer " *url-work")
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 12a8a9c2e21..33a5ebcdccc 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -24,7 +24,7 @@
;;; Commentary:
-;; Registered URI schemes: http://www.iana.org/assignments/uri-schemes
+;; Registered URI schemes: https://www.iana.org/assignments/uri-schemes
;;; Code:
@@ -238,7 +238,8 @@ how long to wait for a response before giving up."
(let ((retrieval-done nil)
(start-time (current-time))
(url-asynchronous nil)
- (asynch-buffer nil))
+ (asynch-buffer nil)
+ (timed-out nil))
(setq asynch-buffer
(url-retrieve url (lambda (&rest ignored)
(url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer))
@@ -261,7 +262,9 @@ how long to wait for a response before giving up."
;; process output.
(while (and (not retrieval-done)
(or (not timeout)
- (time-less-p (time-since start-time) timeout)))
+ (not (setq timed-out
+ (time-less-p timeout
+ (time-since start-time))))))
(url-debug 'retrieval
"Spinning in url-retrieve-synchronously: %S (%S)"
retrieval-done asynch-buffer)
@@ -300,8 +303,16 @@ how long to wait for a response before giving up."
(when quit-flag
(delete-process proc))
(setq proc (and (not quit-flag)
- (get-buffer-process asynch-buffer)))))))
- asynch-buffer)))
+ (get-buffer-process asynch-buffer))))))
+ ;; On timeouts, make sure we kill any pending processes.
+ ;; There may be more than one if we had a redirect.
+ (when timed-out
+ (when (process-live-p proc)
+ (delete-process proc))
+ (when-let ((aproc (get-buffer-process asynch-buffer)))
+ (when (process-live-p aproc)
+ (delete-process aproc))))))
+ asynch-buffer))
;; url-mm-callback called from url-mm, which requires mm-decode.
(declare-function mm-dissect-buffer "mm-decode"
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index d302fb16eda..54bb3569788 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -667,7 +667,7 @@ With a numeric prefix ARG, go back ARG comments."
"Prompt for a change log name."
(let* ((default (change-log-name))
(name (expand-file-name
- (read-file-name (format "Log file (default %s): " default)
+ (read-file-name (format-prompt "Log file" default)
nil default))))
;; Handle something that is syntactically a directory name.
;; Look for ChangeLog or whatever in that directory.
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 8171a585158..5aeb8feb990 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -83,7 +83,10 @@ When editing a diff file, the line numbers in the hunk headers
need to be kept consistent with the actual diff. This can
either be done on the fly (but this sometimes interacts poorly with the
undo mechanism) or whenever the file is written (can be slow
-when editing big diffs)."
+when editing big diffs).
+
+If this variable is nil, the hunk header numbers are updated when
+the file is written instead."
:type 'boolean)
(defcustom diff-advance-after-apply-hunk t
@@ -205,6 +208,8 @@ and hunk-based syntax highlighting otherwise as a fallback."
;; `d' because it duplicates the context :-( --Stef
("\C-c\C-d" . diff-unified->context)
("\C-c\C-w" . diff-ignore-whitespace-hunk)
+ ;; `l' because it "refreshes" the hunk like C-l refreshes the screen
+ ("\C-c\C-l" . diff-refresh-hunk)
("\C-c\C-b" . diff-refine-hunk) ;No reason for `b' :-(
("\C-c\C-f" . next-error-follow-minor-mode))
"Keymap for `diff-mode'. See also `diff-mode-shared-map'.")
@@ -241,6 +246,8 @@ and hunk-based syntax highlighting otherwise as a fallback."
:help "Split the current (unified diff) hunk at point into two hunks"]
["Ignore whitespace changes" diff-ignore-whitespace-hunk
:help "Re-diff the current hunk, ignoring whitespace differences"]
+ ["Recompute the hunk" diff-refresh-hunk
+ :help "Re-diff the current hunk, keeping the whitespace differences"]
["Highlight fine changes" diff-refine-hunk
:help "Highlight changes of hunk at point at a finer granularity"]
["Kill current hunk" diff-hunk-kill
@@ -392,6 +399,12 @@ well."
'((t :inherit diff-file-header))
"`diff-mode' face used to highlight nonexistent files in recursive diffs.")
+(defface diff-error
+ '((((class color))
+ :foreground "red" :background "black" :weight bold)
+ (t :weight bold))
+ "`diff-mode' face for error messages from diff.")
+
(defconst diff-yank-handler '(diff-yank-function))
(defun diff-yank-function (text)
;; FIXME: the yank-handler is now called separately on each piece of text
@@ -472,6 +485,7 @@ and the face `diff-added' for added lines.")
("^\\(#\\)\\(.*\\)"
(1 font-lock-comment-delimiter-face)
(2 font-lock-comment-face))
+ ("^diff: .*" (0 'diff-error))
("^[^-=+*!<>#].*\n" (0 'diff-context))
(,#'diff--font-lock-syntax)
(,#'diff--font-lock-prettify)
@@ -484,7 +498,7 @@ and the face `diff-added' for added lines.")
;; Prefer second name as first is most likely to be a backup or
;; version-control name. The [\t\n] at the end of the unidiff pattern
;; catches Debian source diff files (which lack the trailing date).
- '((nil "\\+\\+\\+\\ \\([^\t\n]+\\)[\t\n]" 1) ; unidiffs
+ '((nil "\\+\\+\\+ \\([^\t\n]+\\)[\t\n]" 1) ; unidiffs
(nil "^--- \\([^\t\n]+\\)\t.*\n\\*" 1))) ; context diffs
;;;;
@@ -923,8 +937,12 @@ If the OLD prefix arg is passed, tell the file NAME of the old file."
(progn (diff-hunk-prev) (point))
(error (point-min)))))
(header-files
- ;; handle filenames with spaces;
+ ;; handle file names with spaces;
;; cf. diff-font-lock-keywords / diff-file-header
+ ;; FIXME if there are nonascii characters in the file names,
+ ;; GNU diff displays them as octal escapes.
+ ;; This function should undo that, so as to return file names
+ ;; that are usable in Emacs.
(if (looking-at "[-*][-*][-*] \\([^\t\n]+\\).*\n[-+][-+][-+] \\([^\t\n]+\\)")
(list (if old (match-string 1) (match-string 2))
(if old (match-string 2) (match-string 1)))
@@ -1846,7 +1864,10 @@ SWITCHED is non-nil if the patch is already applied."
(buf (if revision
(let ((vc-find-revision-no-save t))
(vc-find-revision (expand-file-name file) revision diff-vc-backend))
- (find-file-noselect file))))
+ ;; NOPROMPT is only non-nil when called from
+ ;; `which-function-mode', so avoid "File x changed
+ ;; on disk. Reread from disk?" warnings.
+ (find-file-noselect file noprompt))))
;; Update the user preference if he so wished.
(when (> (prefix-numeric-value other-file) 8)
(setq diff-jump-to-old-file other))
@@ -1988,8 +2009,7 @@ revision of the file otherwise."
(diff-find-source-location other-file reverse)))
(pop-to-buffer buf)
(goto-char (+ (car pos) (cdr src)))
- (when buffer (next-error-found buffer (current-buffer)))
- (diff-hunk-status-msg line-offset (xor reverse switched) t))))
+ (when buffer (next-error-found buffer (current-buffer))))))
(defun diff-current-defun ()
@@ -2029,8 +2049,15 @@ For use in `add-log-current-defun-function'."
(defun diff-ignore-whitespace-hunk ()
"Re-diff the current hunk, ignoring whitespace differences."
(interactive)
+ (diff-refresh-hunk t))
+
+(defun diff-refresh-hunk (&optional ignore-whitespace)
+ "Re-diff the current hunk."
+ (interactive)
(let* ((char-offset (- (point) (diff-beginning-of-hunk t)))
- (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b")))
+ (opt-type (pcase (char-after)
+ (?@ "-u")
+ (?* "-c")))
(line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
(error "Can't find line number"))
(string-to-number (match-string 1))))
@@ -2041,7 +2068,12 @@ For use in `add-log-current-defun-function'."
(file1 (make-temp-file "diff1"))
(file2 (make-temp-file "diff2"))
(coding-system-for-read buffer-file-coding-system)
- old new)
+ opts old new)
+ (when ignore-whitespace
+ (setq opts '("-b")))
+ (when opt-type
+ (setq opts (cons opt-type opts)))
+
(unwind-protect
(save-excursion
(setq old (diff-hunk-text hunk nil char-offset))
@@ -2050,8 +2082,9 @@ For use in `add-log-current-defun-function'."
(write-region (concat lead (car new)) nil file2 nil 'nomessage)
(with-temp-buffer
(let ((status
- (call-process diff-command nil t nil
- opts file1 file2)))
+ (apply 'call-process
+ `(,diff-command nil t nil
+ ,@opts ,file1 ,file2))))
(pcase status
(0 nil) ;Nothing to reformat.
(1 (goto-char (point-min))
@@ -2163,9 +2196,10 @@ Return new point, if it was moved."
(smerge-refine-regions beg-del beg-add beg-add end-add
nil #'diff-refine-preproc props-r props-a)))))
('context
- (let* ((middle (save-excursion (re-search-forward "^---" end)))
+ (let* ((middle (save-excursion (re-search-forward "^---" end t)))
(other middle))
- (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
+ (while (and middle
+ (re-search-forward "^\\(?:!.*\n\\)+" middle t))
(smerge-refine-regions (match-beginning 0) (match-end 0)
(save-excursion
(goto-char other)
@@ -2518,7 +2552,7 @@ fixed, visit it in a buffer."
'((?+ . (left-fringe diff-fringe-add diff-indicator-added))
(?- . (left-fringe diff-fringe-del diff-indicator-removed))
(?! . (left-fringe diff-fringe-rep diff-indicator-changed))
- (?\s . (left-fringe diff-fringe-nul))))))
+ (?\s . (left-fringe diff-fringe-nul fringe))))))
(put-text-property (match-beginning 0) (match-end 0) 'display spec))))
;; Mimicks the output of Magit's diff.
;; FIXME: This has only been tested with Git's diff output.
@@ -2720,7 +2754,9 @@ hunk text is not found in the source file."
;; When initialization is requested, we should be in a brand new
;; temp buffer.
(cl-assert (null buffer-file-name))
- (let ((enable-local-variables :safe) ;; to find `mode:'
+ ;; Use `:safe' to find `mode:'. In case of hunk-only, use nil because
+ ;; Local Variables list might be incomplete when context is truncated.
+ (let ((enable-local-variables (unless hunk-only :safe))
(buffer-file-name file))
;; Don't run hooks that might assume buffer-file-name
;; really associates buffer with a file (bug#39190).
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 469888078c4..b7f17bf3c73 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -258,6 +258,8 @@ This requires the external program `diff' to be in your `exec-path'."
(interactive "bBuffer: ")
(let ((buf (get-buffer (or buffer (current-buffer)))))
(with-current-buffer (or (buffer-base-buffer buf) buf)
+ (unless buffer-file-name
+ (error "Buffer is not visiting a file"))
(diff buffer-file-name (current-buffer) nil 'noasync))))
;;;###autoload
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index ef466741b24..ccf5a7807f2 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -325,6 +325,10 @@ one optional arguments, diff-number to refine.")
(error-buf ediff-error-buffer))
(ediff-skip-unsuitable-frames)
(switch-to-buffer error-buf)
+ ;; We output data from the diff command using `raw-text' as
+ ;; the coding system, so decode before displaying.
+ (when (eq ediff-coding-system-for-read 'raw-text)
+ (decode-coding-region (point-min) (point-max) 'undecided))
(ediff-kill-buffer-carefully ctl-buf)
(user-error "Errors in diff output. Diff output is in %S" diff-buff))))
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index fb1f25b6c6d..04926af16ef 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -452,6 +452,8 @@ For each buffer, the hooks are run with that buffer made current."
"Hook run after Ediff is loaded. Can be used to change defaults."
:type 'hook
:group 'ediff-hook)
+(make-obsolete-variable 'ediff-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom ediff-mode-hook nil
"Hook run just after ediff-mode is set up in the control buffer.
@@ -1255,22 +1257,8 @@ Instead, C-h would jump to previous difference."
:type 'boolean
:group 'ediff)
-;; This is the same as temporary-file-directory from Emacs 20.3.
-;; Copied over here because XEmacs doesn't have this variable.
-(defcustom ediff-temp-file-prefix
- (file-name-as-directory
- (cond ((boundp 'temporary-file-directory) temporary-file-directory)
- ((fboundp 'temp-directory) (temp-directory))
- (t "/tmp/")))
-;;; (file-name-as-directory
-;;; (cond ((memq system-type '(ms-dos windows-nt))
-;;; (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
-;;; (t
-;;; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
- "Prefix to put on Ediff temporary file names.
-Do not start with `~/' or `~USERNAME/'."
- :type 'string
- :group 'ediff)
+(define-obsolete-variable-alias 'ediff-temp-file-prefix
+ 'temporary-file-directory "28.1")
(defcustom ediff-temp-file-mode 384 ; u=rw only
"Mode for Ediff temporary files."
@@ -1282,11 +1270,11 @@ Do not start with `~/' or `~USERNAME/'."
(defcustom ediff-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
"Regexp that matches characters that must be quoted with `\\' in shell command line.
This default should work without changes."
- :type 'string
+ :type 'regexp
:group 'ediff)
-;; needed to simulate frame-char-width in XEmacs.
-(defvar ediff-H-glyph (if (featurep 'xemacs) (make-glyph "H")))
+(defvar ediff-H-glyph nil)
+(make-obsolete-variable 'ediff-H-glyph nil "28.1")
;; Temporary file used for refining difference regions in buffer A.
@@ -1522,34 +1510,9 @@ This default should work without changes."
(setq dir (substring dir 0 pos)))
(ediff-abbreviate-file-name (file-name-directory dir))))
-(defun ediff-truncate-string-left (str newlen)
- ;; leave space for ... on the left
- (let ((len (length str))
- substr)
- (if (<= len newlen)
- str
- (setq newlen (max 0 (- newlen 3)))
- (setq substr (substring str (max 0 (- len 1 newlen))))
- (concat "..." substr))))
-
(defsubst ediff-nonempty-string-p (string)
(and (stringp string) (not (string= string ""))))
-(unless (fboundp 'subst-char-in-string)
- (defun subst-char-in-string (fromchar tochar string &optional inplace)
- "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
-Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> i 0)
- (setq i (1- i))
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr)))
-
-(unless (fboundp 'format-message)
- (defalias 'format-message 'format))
-
(defun ediff-abbrev-jobname (jobname)
(cond ((eq jobname 'ediff-directories)
"Compare two directories")
@@ -1610,9 +1573,8 @@ Unless optional argument INPLACE is non-nil, return a new string."
(defun ediff-convert-standard-filename (fname)
- (if (fboundp 'convert-standard-filename)
- (convert-standard-filename fname)
- fname))
+ (declare (obsolete convert-standard-filename "28.1"))
+ (convert-standard-filename fname))
(define-obsolete-function-alias 'ediff-with-syntax-table
#'with-syntax-table "27.1")
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index fee87e8352e..c977291a524 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -113,7 +113,6 @@
(require 'ediff-wind)
(require 'ediff-util)
-
;; meta-buffer
(ediff-defvar-local ediff-meta-buffer nil "")
(ediff-defvar-local ediff-parent-meta-buffer nil "")
@@ -1172,7 +1171,7 @@ behavior."
;; abbreviate the file name, if file exists
(if (and (not (stringp fname)) (< file-size -1))
"-------" ; file doesn't exist
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name fname)
max-filename-width)))))))
@@ -1266,7 +1265,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code1) 0) ; dir1
(let ((beg (point)))
(insert (format "%-27s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir1 file))
(file-name-as-directory file)
@@ -1281,7 +1280,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code2) 0) ; dir2
(let ((beg (point)))
(insert (format "%-26s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir2 file))
(file-name-as-directory file)
@@ -1295,7 +1294,7 @@ Useful commands:
(if (= (mod membership-code ediff-membership-code3) 0) ; dir3
(let ((beg (point)))
(insert (format " %-25s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir3 file))
(file-name-as-directory file)
@@ -1808,11 +1807,9 @@ all marked sessions must be active."
(ediff-show-meta-buffer session-buf)
(setq regexp
(read-string
- (if (stringp default-regexp)
- (format
- "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt
+ "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp t)))
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index cb0ae6ff6e1..f6af5a45550 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -119,7 +119,7 @@ patch. So, don't change these variables, unless the default doesn't work."
(defcustom ediff-context-diff-label-regexp
(let ((stuff "\\([^ \t\n]+\\)"))
(concat "\\(" ; context diff 2-liner
- "^\\*\\*\\* +" stuff "[^*]+[\t ]*\n--- +" stuff
+ "^\\*\\*\\* +" stuff "[^*]+\n--- +" stuff
"\\|" ; unified format diff 2-liner
"^--- +" stuff ".*\n\\+\\+\\+ +" stuff
"\\)"))
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index a8af9ba37a2..e28d8574b1c 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -131,7 +131,6 @@ to invocation.")
(define-key ediff-mode-map [delete] 'ediff-previous-difference)
(define-key ediff-mode-map "\C-h" (if ediff-no-emacs-help-in-control-buffer
'ediff-previous-difference nil))
- ;; must come after C-h, or else C-h wipes out backspace's binding in XEmacs
(define-key ediff-mode-map [backspace] 'ediff-previous-difference)
(define-key ediff-mode-map [?\S-\ ] 'ediff-previous-difference)
(define-key ediff-mode-map "n" 'ediff-next-difference)
@@ -241,18 +240,16 @@ to invocation.")
startup-hooks setup-parameters
&optional merge-buffer-file)
(run-hooks 'ediff-before-setup-hook)
- ;; ediff-convert-standard-filename puts file names in the form appropriate
+ ;; convert-standard-filename puts file names in the form appropriate
;; for the OS at hand.
- (setq file-A (ediff-convert-standard-filename (expand-file-name file-A)))
- (setq file-B (ediff-convert-standard-filename (expand-file-name file-B)))
+ (setq file-A (convert-standard-filename (expand-file-name file-A)))
+ (setq file-B (convert-standard-filename (expand-file-name file-B)))
(if (stringp file-C)
- (setq file-C
- (ediff-convert-standard-filename (expand-file-name file-C))))
+ (setq file-C (convert-standard-filename (expand-file-name file-C))))
(if (stringp merge-buffer-file)
(progn
(setq merge-buffer-file
- (ediff-convert-standard-filename
- (expand-file-name merge-buffer-file)))
+ (convert-standard-filename (expand-file-name merge-buffer-file)))
;; check the directory exists
(or (file-exists-p (file-name-directory merge-buffer-file))
(error "Directory %s given as place to save the merge doesn't exist"
@@ -1540,10 +1537,10 @@ the width of the A/B/C windows."
;; hscrolling.
(if (= last-command-event ?<)
(lambda (arg)
- (let ((prefix-arg arg))
+ (let ((current-prefix-arg arg))
(call-interactively #'scroll-left)))
(lambda (arg)
- (let ((prefix-arg arg))
+ (let ((current-prefix-arg arg))
(call-interactively #'scroll-right))))
;; calculate argument to scroll-left/right
;; if there is an explicit argument
@@ -2184,19 +2181,18 @@ a regular expression typed in by the user."
(setq ediff-skip-diff-region-function ediff-hide-regexp-matches-function
regexp-A
(read-string
- (format
- "Ignore A-regions matching this regexp (default %s): "
- ediff-regexp-hide-A))
+ (format-prompt
+ "Ignore A-regions matching this regexp" ediff-regexp-hide-A))
regexp-B
(read-string
- (format
- "Ignore B-regions matching this regexp (default %s): "
+ (format-prompt
+ "Ignore B-regions matching this regexp"
ediff-regexp-hide-B)))
(if ediff-3way-comparison-job
(setq regexp-C
(read-string
- (format
- "Ignore C-regions matching this regexp (default %s): "
+ (format-prompt
+ "Ignore C-regions matching this regexp"
ediff-regexp-hide-C))))
(if (eq ediff-hide-regexp-connective 'and)
(setq msg-connective "BOTH"
@@ -2223,20 +2219,18 @@ a regular expression typed in by the user."
ediff-focus-on-regexp-matches-function
regexp-A
(read-string
- (format
- "Focus on A-regions matching this regexp (default %s): "
- ediff-regexp-focus-A))
+ (format-prompt
+ "Focus on A-regions matching this regexp" ediff-regexp-focus-A))
regexp-B
(read-string
- (format
- "Focus on B-regions matching this regexp (default %s): "
- ediff-regexp-focus-B)))
+ (format-prompt
+ "Focus on B-regions matching this regexp" ediff-regexp-focus-B)))
(if ediff-3way-comparison-job
(setq regexp-C
(read-string
- (format
- "Focus on C-regions matching this regexp (default %s): "
- ediff-regexp-focus-C))))
+ (format-prompt
+ "Focus on C-regions matching this regexp"
+ ediff-regexp-focus-C))))
(if (eq ediff-focus-regexp-connective 'and)
(setq msg-connective "BOTH"
alt-msg-connective "ONE OF"
@@ -3070,10 +3064,8 @@ Hit \\[ediff-recenter] to reset the windows afterward."
;; for compatibility
-(defmacro ediff-minibuffer-with-setup-hook (fun &rest body)
- `(if (fboundp 'minibuffer-with-setup-hook)
- (minibuffer-with-setup-hook ,fun ,@body)
- ,@body))
+(define-obsolete-function-alias 'ediff-minibuffer-with-setup-hook
+ #'minibuffer-with-setup-hook "28.1")
;; This is adapted from a similar function in `emerge.el'.
;; PROMPT should not have a trailing ': ', so that it can be modified
@@ -3102,7 +3094,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(and default-file (list default-file))
default-dir)))
f)
- (setq f (ediff-minibuffer-with-setup-hook
+ (setq f (minibuffer-with-setup-hook
(lambda () (when defaults
(setq minibuffer-default defaults)))
(read-file-name
@@ -3135,7 +3127,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
;; Also, save buffer from START to END in the file.
;; START defaults to (point-min), END to (point-max)
(defun ediff-make-temp-file (buff &optional prefix given-file start end)
- (let* ((p (ediff-convert-standard-filename (or prefix "ediff")))
+ (let* ((p (convert-standard-filename (or prefix "ediff")))
(short-p p)
(coding-system-for-write ediff-coding-system-for-write)
f short-f)
@@ -3144,8 +3136,8 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(> (length p) 2))
(setq short-p (substring p 0 2)))
- (setq f (concat ediff-temp-file-prefix p)
- short-f (concat ediff-temp-file-prefix short-p)
+ (setq f (concat temporary-file-directory p)
+ short-f (concat temporary-file-directory short-p)
f (cond (given-file)
((find-file-name-handler f 'insert-file-contents)
;; to thwart file name handlers in write-region,
@@ -3449,7 +3441,6 @@ Without an argument, it saves customized diff argument, if available
(declare-function ediff-regions-internal "ediff"
(buffer-a beg-a end-a buffer-b beg-b end-b
startup-hooks job-name word-mode setup-parameters))
-(defvar zmacs-regions) ;;XEmacs'ism.
(defun ediff-inferior-compare-regions ()
"Compare regions in an active Ediff session.
@@ -3461,7 +3452,6 @@ Ediff Control Panel to restore highlighting."
(interactive)
(let ((answer "")
(possibilities (list ?A ?B ?C))
- (zmacs-regions t)
use-current-diff-p
begA begB endA endB bufA bufB)
@@ -4139,10 +4129,10 @@ Mail anyway? (y or n) ")
(ediff-with-current-buffer standard-output
(fundamental-mode))
(princ (format "\nCtl buffer: %S\n" ediff-control-buffer))
- (ediff-print-diff-vector (intern "ediff-difference-vector-A"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-B"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-C"))
- (ediff-print-diff-vector (intern "ediff-difference-vector-Ancestor"))
+ (ediff-print-diff-vector 'ediff-difference-vector-A)
+ (ediff-print-diff-vector 'ediff-difference-vector-B)
+ (ediff-print-diff-vector 'ediff-difference-vector-C)
+ (ediff-print-diff-vector 'ediff-difference-vector-Ancestor)
))
diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el
index a95606fad5e..4ee7ee5c1f5 100644
--- a/lisp/vc/ediff-vers.el
+++ b/lisp/vc/ediff-vers.el
@@ -49,15 +49,10 @@ comparison or merge operations are being performed."
:group 'ediff-vers
)
-(defalias 'ediff-vc-revision-other-window
- (if (fboundp 'vc-revision-other-window)
- 'vc-revision-other-window
- 'vc-version-other-window))
-
-(defalias 'ediff-vc-working-revision
- (if (fboundp 'vc-working-revision)
- 'vc-working-revision
- 'vc-workfile-version))
+(define-obsolete-function-alias 'ediff-vc-revision-other-window
+ #'vc-revision-other-window "28.1")
+(define-obsolete-function-alias 'ediff-vc-working-revision
+ #'vc-working-revision "28.1")
;; VC.el support
@@ -88,12 +83,12 @@ comparison or merge operations are being performed."
(setq rev1 (ediff-vc-latest-version (buffer-file-name))))
(save-window-excursion
(save-excursion
- (ediff-vc-revision-other-window rev1)
+ (vc-revision-other-window rev1)
(setq rev1buf (current-buffer)
file1 (buffer-file-name)))
(save-excursion
(or (string= rev2 "") ; use current buffer
- (ediff-vc-revision-other-window rev2))
+ (vc-revision-other-window rev2))
(setq rev2buf (current-buffer)
file2 (buffer-file-name)))
(push (lambda ()
@@ -165,18 +160,18 @@ comparison or merge operations are being performed."
(let (buf1 buf2 ancestor-buf)
(save-window-excursion
(save-excursion
- (ediff-vc-revision-other-window rev1)
+ (vc-revision-other-window rev1)
(setq buf1 (current-buffer)))
(save-excursion
(or (string= rev2 "")
- (ediff-vc-revision-other-window rev2))
+ (vc-revision-other-window rev2))
(setq buf2 (current-buffer)))
(if ancestor-rev
(save-excursion
(if (string= ancestor-rev "")
- (setq ancestor-rev (ediff-vc-working-revision
+ (setq ancestor-rev (vc-working-revision
buffer-file-name)))
- (ediff-vc-revision-other-window ancestor-rev)
+ (vc-revision-other-window ancestor-rev)
(setq ancestor-buf (current-buffer))))
(push (let ((f1 (buffer-file-name buf1))
(f2 (unless (string= rev2 "") (buffer-file-name buf2)))
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 7b2e1109c87..a23d72070ab 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -156,12 +156,10 @@ In this case, Ediff will use those frames to display these buffers."
'(name . "Ediff")
;;'(unsplittable . t)
'(minibuffer . nil)
- '(user-position . t) ; Emacs only
- '(vertical-scroll-bars . nil) ; Emacs only
- '(scrollbar-width . 0) ; XEmacs only
- '(scrollbar-height . 0) ; XEmacs only
- '(menu-bar-lines . 0) ; Emacs only
- '(tool-bar-lines . 0) ; Emacs 21+ only
+ '(user-position . t)
+ '(vertical-scroll-bars . nil)
+ '(menu-bar-lines . 0)
+ '(tool-bar-lines . 0)
'(left-fringe . 0)
'(right-fringe . 0)
;; don't lower but auto-raise
@@ -260,10 +258,9 @@ the frame used for the wide display.")
This has effect only on a windowing system.
If t, hitting `?' to toggle control panel off iconifies it.
-This is only useful in Emacs and only for certain kinds of window managers,
-such as TWM and its derivatives, since the window manager must permit
-keyboard input to go into icons. XEmacs completely ignores keyboard input
-into icons, regardless of the window manager."
+This is only useful for certain kinds of window managers, such as
+TWM and its derivatives, since the window manager must permit
+keyboard input to go into icons."
:type 'boolean)
;;; Functions
@@ -952,8 +949,7 @@ create a new splittable frame if none is found."
;; just a precaution--we should be in ctl-buffer already
(with-current-buffer ctl-buffer
(make-local-variable 'frame-title-format)
- (make-local-variable 'frame-icon-title-format) ; XEmacs
- (make-local-variable 'icon-title-format)) ; Emacs
+ (make-local-variable 'icon-title-format))
(ediff-setup-control-buffer ctl-buffer)
(setq dont-iconify-ctl-frame
@@ -1098,6 +1094,7 @@ create a new splittable frame if none is found."
)))
(defun ediff-xemacs-select-frame-hook ()
+ (declare (obsolete nil "28.1"))
(if (and (equal (selected-frame) ediff-control-frame)
(not ediff-use-long-help-message))
(raise-frame ediff-control-frame)))
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 133d2109f5b..ae2f8ad6c1c 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -566,10 +566,8 @@ expression; only file names that match the regexp are considered."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -594,10 +592,8 @@ names. Only the files that are under revision control are taken into account."
(list (read-directory-name
"Directory to compare with revision:" dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt
+ "Filter filenames through regular expression" default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -632,10 +628,8 @@ regular expression; only file names that match the regexp are considered."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -665,10 +659,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -707,10 +699,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(ediff-strip-last-dir f))
nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -735,10 +725,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(list (read-directory-name
"Directory to merge with revisions:" dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -767,10 +755,8 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
"Directory to merge with revisions and ancestors:"
dir-A nil 'must-match)
(read-string
- (if (stringp default-regexp)
- (format "Filter filenames through regular expression (default %s): "
- default-regexp)
- "Filter filenames through regular expression: ")
+ (format-prompt "Filter filenames through regular expression"
+ default-regexp)
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -1353,16 +1339,18 @@ the merge buffer."
(let (rev1 rev2)
(setq rev1
(read-string
- (format-message
- "Version 1 to merge (default %s's working version): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 1 to merge"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s working version")))
rev2
(read-string
- (format
- "Version 2 to merge (default %s): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer"))))
+ (format-prompt "Version 2 to merge"
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer"))))
(ediff-load-version-control)
;; ancestor-revision=nil
(funcall
@@ -1388,22 +1376,26 @@ the merge buffer."
(let (rev1 rev2 ancestor-rev)
(setq rev1
(read-string
- (format-message
- "Version 1 to merge (default %s's working version): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 1 to merge"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s working version")))
rev2
(read-string
- (format
- "Version 2 to merge (default %s): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer")))
+ (format-prompt "Version 2 to merge"
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")))
ancestor-rev
- (read-string
- (format-message
- "Ancestor version (default %s's base revision): "
- (if (stringp file)
- (file-name-nondirectory file) "current buffer"))))
+ (read-string (format-prompt
+ "Ancestor version"
+ (concat
+ (if (stringp file)
+ (file-name-nondirectory file)
+ "current buffer")
+ "'s base revision"))))
(ediff-load-version-control)
(funcall
(intern (format "ediff-%S-merge-internal" ediff-version-control-package))
@@ -1503,13 +1495,14 @@ arguments after setting up the Ediff buffers."
(save-buffer (current-buffer)))
(let (rev1 rev2)
(setq rev1
- (read-string
- (format "Revision 1 to compare (default %s's latest revision): "
- (file-name-nondirectory file)))
+ (read-string (format-prompt "Revision 1 to compare"
+ (concat (file-name-nondirectory file)
+ "'s latest revision")))
rev2
(read-string
- (format "Revision 2 to compare (default %s's current state): "
- (file-name-nondirectory file))))
+ (format-prompt "Revision 2 to compare"
+ (concat (file-name-nondirectory file)
+ "'s current state"))))
(ediff-load-version-control)
(funcall
(intern (format "ediff-%S-internal" ediff-version-control-package))
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index fc8c318e3af..d2d419ac786 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -2757,15 +2757,14 @@ Otherwise, signal an error."
alternative-default-dir
(not (string-equal alternative-default-dir
(file-name-directory A-file))))
- (read-file-name (format "%s (default %s): "
- prompt (file-name-nondirectory A-file))
+ (read-file-name (format-prompt prompt (file-name-nondirectory A-file))
alternative-default-dir
(concat alternative-default-dir
(file-name-nondirectory A-file))
(and must-match 'confirm)))
;; If there is a default file, use it.
(default-file
- (read-file-name (format "%s (default %s): " prompt default-file)
+ (read-file-name (format-prompt prompt default-file)
;; If emerge-default-last-directories is set, use the
;; directory from the same argument of the last call of
;; Emerge as the default for this argument.
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 906f9a94205..1c69bdf4135 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -51,6 +51,9 @@
;; The main keymap
+(define-obsolete-variable-alias 'vc-log-mode-map 'log-edit-mode-map "28.1")
+(define-obsolete-variable-alias 'vc-log-entry-mode 'log-edit-mode-map "28.1")
+
(easy-mmode-defmap log-edit-mode-map
'(("\C-c\C-c" . log-edit-done)
("\C-c\C-a" . log-edit-insert-changelog)
@@ -67,10 +70,6 @@
"Keymap for the `log-edit-mode' (to edit version control log messages)."
:group 'log-edit)
-;; Compatibility with old names. Should we bother ?
-(defvar vc-log-mode-map log-edit-mode-map)
-(defvar vc-log-entry-mode vc-log-mode-map)
-
(easy-menu-define log-edit-menu log-edit-mode-map
"Menu used for `log-edit-mode'."
'("Log-Edit"
@@ -245,7 +244,9 @@ If the optional argument STRIDE is present, that is a step-width to use
when going through the comment ring."
;; Why substring rather than regexp ? -sm
(interactive
- (list (read-string "Comment substring: " nil nil log-edit-last-comment-match)))
+ (list (read-string (format-prompt "Comment substring"
+ log-edit-last-comment-match)
+ nil nil log-edit-last-comment-match)))
(unless stride (setq stride 1))
(if (string= str "")
(setq str log-edit-last-comment-match)
@@ -262,7 +263,9 @@ when going through the comment ring."
(defun log-edit-comment-search-forward (str)
"Search forwards through comment history for a substring match of STR."
(interactive
- (list (read-string "Comment substring: " nil nil log-edit-last-comment-match)))
+ (list (read-string (format-prompt "Comment substring"
+ log-edit-last-comment-match)
+ nil nil log-edit-last-comment-match)))
(log-edit-comment-search-backward str -1))
(defun log-edit-comment-to-change-log (&optional whoami file-name)
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index e1c2b976a49..56ecc64671c 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -208,6 +208,18 @@ If it is nil, `log-view-toggle-entry-display' does nothing.")
"Face for the message header line in `log-view-mode'."
:group 'log-view)
+(defface log-view-commit-body
+ '((((class color) (min-colors 88) (background light))
+ :background "gray95" :foreground "black" :extend t)
+ (((class color) (min-colors 88) (background dark))
+ :background "gray5" :foreground "white" :extend t)
+ (((class color) (min-colors 8) (background light))
+ :foreground "black")
+ (((class color) (min-colors 8) (background dark))
+ :foreground "white"))
+ "Face for the commit body in `log-view-mode'."
+ :version "28.1")
+
(defvar log-view-file-re
(concat "^\\(?:Working file: \\(?1:.+\\)" ;RCS and CVS.
;; Subversion has no such thing??
@@ -415,7 +427,7 @@ This calls `log-view-expanded-log-entry-function' to do the work."
(insert long-entry "\n")
(add-text-properties
beg (point)
- '(font-lock-face font-lock-comment-face log-view-comment t))
+ '(font-lock-face log-view-commit-body log-view-comment t))
(goto-char opoint))))))))
(defun log-view-beginning-of-defun (&optional arg)
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index 466c621311f..dd56aec94a0 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -472,7 +472,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
;; Let's not get all worked up if the format changes a bit
(cvs-match " *Working revision:.*$"))
(cvs-or
- (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\)[ \t]*.*$" (head-rev 1))
+ (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\).*$" (head-rev 1))
(cvs-match " *Repository revision:[ \t]*\\([0-9.]+\\)[ \t]*\\(.*\\)$"
(head-rev 1))
(cvs-match " *Repository revision:.*"))
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 85868b91ecc..fe7724d9027 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1352,24 +1352,26 @@ buffer names."
;; Do a few further adjustments and take precautions for exit.
(set (make-local-variable 'smerge-ediff-windows) config)
(set (make-local-variable 'smerge-ediff-buf) buf)
- (set (make-local-variable 'ediff-quit-hook)
- (lambda ()
- (let ((buffer-A ediff-buffer-A)
- (buffer-B ediff-buffer-B)
- (buffer-C ediff-buffer-C)
- (buffer-Ancestor ediff-ancestor-buffer)
- (buf smerge-ediff-buf)
- (windows smerge-ediff-windows))
- (ediff-cleanup-mess)
- (with-current-buffer buf
- (erase-buffer)
- (insert-buffer-substring buffer-C)
- (kill-buffer buffer-A)
- (kill-buffer buffer-B)
- (kill-buffer buffer-C)
- (when (bufferp buffer-Ancestor) (kill-buffer buffer-Ancestor))
- (set-window-configuration windows)
- (message "Conflict resolution finished; you may save the buffer")))))
+ (add-hook 'ediff-quit-hook
+ (lambda ()
+ (let ((buffer-A ediff-buffer-A)
+ (buffer-B ediff-buffer-B)
+ (buffer-C ediff-buffer-C)
+ (buffer-Ancestor ediff-ancestor-buffer)
+ (buf smerge-ediff-buf)
+ (windows smerge-ediff-windows))
+ (ediff-cleanup-mess)
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert-buffer-substring buffer-C)
+ (kill-buffer buffer-A)
+ (kill-buffer buffer-B)
+ (kill-buffer buffer-C)
+ (when (bufferp buffer-Ancestor)
+ (kill-buffer buffer-Ancestor))
+ (set-window-configuration windows)
+ (message "Conflict resolution finished; you may save the buffer"))))
+ nil t)
(message "Please resolve conflicts now; exit ediff when done")))
(defun smerge-makeup-conflict (pt1 pt2 pt3 &optional pt4)
@@ -1429,15 +1431,16 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
(smerge-remove-props (point-min) (point-max))))
;;;###autoload
-(defun smerge-start-session ()
+(defun smerge-start-session (&optional interactively)
"Turn on `smerge-mode' and move point to first conflict marker.
If no conflict maker is found, turn off `smerge-mode'."
- (interactive)
- (smerge-mode 1)
- (condition-case nil
- (unless (looking-at smerge-begin-re)
- (smerge-next))
- (error (smerge-auto-leave))))
+ (interactive "p")
+ (when (or (null smerge-mode) interactively)
+ (smerge-mode 1)
+ (condition-case nil
+ (unless (looking-at smerge-begin-re)
+ (smerge-next))
+ (error (smerge-auto-leave)))))
(defcustom smerge-change-buffer-confirm t
"If non-nil, request confirmation before moving to another buffer."
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index d82cadc70dd..5198bccf846 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -403,12 +403,12 @@ should be applied to the background or to the foreground."
(let ((def (vc-working-revision buffer-file-name)))
(if (null current-prefix-arg) def
(vc-read-revision
- (format "Annotate from revision (default %s): " def)
+ (format-prompt "Annotate from revision" def)
(list buffer-file-name) nil def)))
(if (null current-prefix-arg)
vc-annotate-display-mode
(float (string-to-number
- (read-string "Annotate span days (default 20): "
+ (read-string (format-prompt "Annotate span days" 20)
nil nil "20")))))))
(vc-ensure-vc-buffer)
(setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e5d307e7ede..e2d0ca69a20 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -26,7 +26,7 @@
;;; Commentary:
-;; See <URL:http://bazaar.canonical.com/> concerning bzr.
+;; See <URL:https://bazaar.canonical.com/> concerning bzr.
;; This library provides bzr support in VC.
@@ -1316,6 +1316,15 @@ stream. Standard error output is discarded."
vc-bzr-revision-keywords))
string pred)))))
+(defun vc-bzr-repository-url (file-or-dir &optional _remote-name)
+ (let ((default-directory (vc-bzr-root file-or-dir)))
+ (with-temp-buffer
+ (vc-bzr-command "info" (current-buffer) 0 nil)
+ (goto-char (point-min))
+ (if (re-search-forward "parent branch: \\(.*\\)$" nil t)
+ (match-string 1)
+ (error "Cannot determine Bzr repository URL")))))
+
(provide 'vc-bzr)
;;; vc-bzr.el ends here
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index e8231ecb289..fdbf44e0f13 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -337,32 +337,35 @@ its parents."
(directory-file-name dir))))
(eq dir t)))
+(declare-function log-edit-extract-headers "log-edit" (headers string))
+
(defun vc-cvs-checkin (files comment &optional rev)
"CVS-specific version of `vc-backend-checkin'."
- (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
- (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
+ (unless (or (not rev) (vc-cvs-valid-revision-number-p rev))
+ (if (not (vc-cvs-valid-symbolic-tag-name-p rev))
(error "%s is not a valid symbolic tag name" rev)
- ;; If the input revision is a valid symbolic tag name, we create it
- ;; as a branch, commit and switch to it.
- (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
- (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
- (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev))
+ ;; If the input revision is a valid symbolic tag name, we create it
+ ;; as a branch, commit and switch to it.
+ (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
+ (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
+ (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev))
files)))
- (let ((status (apply 'vc-cvs-command nil 1 files
- "ci" (if rev (concat "-r" rev))
- (concat "-m" comment)
- (vc-switches 'CVS 'checkin))))
+ (let ((status (apply
+ 'vc-cvs-command nil 1 files
+ "ci" (if rev (concat "-r" rev))
+ (concat "-m" (car (log-edit-extract-headers nil comment)))
+ (vc-switches 'CVS 'checkin))))
(set-buffer "*vc*")
(goto-char (point-min))
(when (not (zerop status))
;; Check checkin problem.
(cond
((re-search-forward "Up-to-date check failed" nil t)
- (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
+ (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge))
files)
(error "%s" (substitute-command-keys
- (concat "Up-to-date check failed: "
- "type \\[vc-next-action] to merge in changes"))))
+ (concat "Up-to-date check failed: "
+ "type \\[vc-next-action] to merge in changes"))))
(t
(pop-to-buffer (current-buffer))
(goto-char (point-min))
@@ -372,7 +375,7 @@ its parents."
;; Otherwise we can't necessarily tell what goes with what; clear
;; its properties so they have to be refetched.
(if (= (length files) 1)
- (vc-file-setprop
+ (vc-file-setprop
(car files) 'vc-working-revision
(vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
(mapc 'vc-file-clearprops files))
@@ -385,7 +388,7 @@ its parents."
;; if this was an explicit check-in (does not include creation of
;; a branch), remove the sticky tag.
(if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev)))
- (vc-cvs-command nil 0 files "update" "-A"))))
+ (vc-cvs-command nil 0 files "update" "-A"))))
(defun vc-cvs-find-revision (file rev buffer)
(apply 'vc-cvs-command
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 38b4937e854..cdf8ab984e8 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -147,6 +147,12 @@ See `run-hooks'."
'(menu-item "Unmark Previous " vc-dir-unmark-file-up
:help "Move to the previous line and unmark the file"))
+ (define-key map [mark-unregistered]
+ '(menu-item "Mark Unregistered" vc-dir-mark-unregistered-files
+ :help "Mark all files in the unregistered state"))
+ (define-key map [mark-registered]
+ '(menu-item "Mark Registered" vc-dir-mark-registered-files
+ :help "Mark all files in the state edited, added or removed"))
(define-key map [mark-all]
'(menu-item "Mark All" vc-dir-mark-all-files
:help "Mark all files that are in the same state as the current file\
@@ -310,6 +316,10 @@ See `run-hooks'."
(define-key branch-map "l" 'vc-print-branch-log)
(define-key branch-map "s" 'vc-retrieve-tag))
+ (let ((mark-map (make-sparse-keymap)))
+ (define-key map "*" mark-map)
+ (define-key mark-map "r" 'vc-dir-mark-registered-files))
+
;; Hook up the menu.
(define-key map [menu-bar vc-dir-mode]
`(menu-item
@@ -696,6 +706,38 @@ share the same state."
(vc-dir-mark-file crt)))
(setq crt (ewoc-next vc-ewoc crt))))))))
+(defun vc-dir-mark-files (mark-files)
+ "Mark files specified by file names in the argument MARK-FILES.
+MARK-FILES should be a list of absolute filenames."
+ (ewoc-map
+ (lambda (filearg)
+ (when (member (expand-file-name (vc-dir-fileinfo->name filearg))
+ mark-files)
+ (setf (vc-dir-fileinfo->marked filearg) t)
+ t))
+ vc-ewoc))
+
+(defun vc-dir-mark-state-files (states)
+ "Mark files that are in the state specified by the list in STATES."
+ (unless (listp states)
+ (setq states (list states)))
+ (ewoc-map
+ (lambda (filearg)
+ (when (memq (vc-dir-fileinfo->state filearg) states)
+ (setf (vc-dir-fileinfo->marked filearg) t)
+ t))
+ vc-ewoc))
+
+(defun vc-dir-mark-registered-files ()
+ "Mark files that are in one of registered state: edited, added or removed."
+ (interactive)
+ (vc-dir-mark-state-files '(edited added removed)))
+
+(defun vc-dir-mark-unregistered-files ()
+ "Mark files that are in unregistered state."
+ (interactive)
+ (vc-dir-mark-state-files 'unregistered))
+
(defun vc-dir-unmark-file ()
;; Unmark the current file and move to the next line.
(let* ((crt (ewoc-locate vc-ewoc))
@@ -1064,6 +1106,7 @@ the *vc-dir* buffer.
(set (make-local-variable 'vc-dir-backend) use-vc-backend)
(set (make-local-variable 'desktop-save-buffer)
'vc-dir-desktop-buffer-misc-data)
+ (setq-local bookmark-make-record-function #'vc-dir-bookmark-make-record)
(setq buffer-read-only t)
(when (boundp 'tool-bar-map)
(set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map))
@@ -1193,7 +1236,8 @@ Throw an error if another update process is in progress."
(if remaining
(vc-dir-refresh-files
(mapcar 'vc-dir-fileinfo->name remaining))
- (setq mode-line-process nil))))))))))))
+ (setq mode-line-process nil)
+ (run-hooks 'vc-dir-refresh-hook))))))))))))
(defun vc-dir-show-fileentry (file)
"Insert an entry for a specific file into the current *VC-dir* listing.
@@ -1287,6 +1331,16 @@ state of item at point, if any."
(list vc-dir-backend files only-files-list state model)))
;;;###autoload
+(defun vc-dir-root ()
+ "Run `vc-dir' in the repository root directory without prompt.
+If the default directory of the current buffer is
+not under version control, prompt for a directory."
+ (interactive)
+ (let ((root-dir (vc-root-dir)))
+ (if root-dir (vc-dir root-dir)
+ (call-interactively 'vc-dir))))
+
+;;;###autoload
(defun vc-dir (dir &optional backend)
"Show the VC status for \"interesting\" files in and below DIR.
This allows you to mark files and perform VC operations on them.
@@ -1309,7 +1363,7 @@ These are the commands available for use in the file status buffer:
;; When you hit C-x v d in a visited VC file,
;; the *vc-dir* buffer visits the directory under its truename;
;; therefore it makes sense to always do that.
- ;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d
+ ;; Otherwise if you do C-x v d -> C-x C-f -> C-x v d
;; you may get a new *vc-dir* buffer, different from the original
(file-truename (read-directory-name "VC status for directory: "
(vc-root-dir) nil t
@@ -1413,6 +1467,42 @@ These are the commands available for use in the file status buffer:
'(vc-dir-mode . vc-dir-restore-desktop-buffer))
+;;; Support for bookmark.el (adapted from what info.el does).
+
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-default-handler "bookmark" (bmk))
+(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+
+(defun vc-dir-bookmark-make-record ()
+ "Make record used to bookmark a `vc-dir' buffer.
+This implements the `bookmark-make-record-function' type for
+`vc-dir' buffers."
+ (let* ((bookmark-name
+ (concat "(" (symbol-name vc-dir-backend) ") "
+ (file-name-nondirectory
+ (directory-file-name default-directory))))
+ (defaults (list bookmark-name default-directory)))
+ `(,bookmark-name
+ ,@(bookmark-make-record-default 'no-file)
+ (filename . ,default-directory)
+ (handler . vc-dir-bookmark-jump)
+ (defaults . ,defaults))))
+
+;;;###autoload
+(defun vc-dir-bookmark-jump (bmk)
+ "Provides the bookmark-jump behavior for a `vc-dir' buffer.
+This implements the `handler' function interface for the record
+type returned by `vc-dir-bookmark-make-record'."
+ (let* ((file (bookmark-prop-get bmk 'filename))
+ (buf (progn ;; Don't use save-window-excursion (bug#39722)
+ (vc-dir file)
+ (current-buffer))))
+ (bookmark-default-handler
+ `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
+
+
(provide 'vc-dir)
;;; vc-dir.el ends here
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 5ae300bf09b..932b9158f2b 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -138,7 +138,9 @@ preserve the setting."
;; Variables the user doesn't need to know about.
(defvar vc-log-operation nil)
-(defvar vc-log-after-operation-hook nil)
+(defvar vc-log-after-operation-hook nil
+ "Name of the hook run at the end of `vc-finish-logentry'.
+BEWARE: Despite its name, this variable is not itself a hook!")
(defvar vc-log-fileset)
;; In a log entry buffer, this is a local variable
@@ -691,7 +693,6 @@ BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer."
(message "%s Type C-c C-c when done" msg)
(vc-finish-logentry (eq comment t)))))
-(declare-function vc-dir-move-to-goal-column "vc-dir" ())
;; vc-finish-logentry is typically called from a log-edit buffer (see
;; vc-start-logentry).
(defun vc-finish-logentry (&optional nocomment)
@@ -740,13 +741,12 @@ the buffer contents as a comment."
(mapc
(lambda (file) (vc-resynch-buffer file t t))
log-fileset))
- (when (vc-dispatcher-browsing)
- (vc-dir-move-to-goal-column))
(run-hooks after-hook 'vc-finish-logentry-hook)))
(defun vc-dispatcher-browsing ()
"Are we in a directory browser buffer?"
- (derived-mode-p 'vc-dir-mode))
+ (or (derived-mode-p 'vc-dir-mode)
+ (derived-mode-p 'dired-mode)))
;; These are unused.
;; (defun vc-dispatcher-in-fileset-p (fileset)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 61e6c642d1f..91554bb6d83 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -72,6 +72,7 @@
;; by git, so it's probably
;; not a good idea.
;; - merge-news (file) see `merge-file'
+;; - mark-resolved (file) OK
;; - steal-lock (file &optional revision) NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional shortlog start-revision limit) OK
@@ -100,6 +101,7 @@
;; - rename-file (old new) OK
;; - find-file-hook () OK
;; - conflicted-files OK
+;; - repository-url (file-or-dir) OK
;;; Code:
@@ -166,7 +168,7 @@ format string (which is passed to \"git log\" via the argument
\"--pretty=tformat:FORMAT\"), REGEXP is a regular expression
matching the resulting Git log output, and KEYWORDS is a list of
`font-lock-keywords' for highlighting the Log View buffer."
- :type '(list string string (repeat sexp))
+ :type '(list string regexp (repeat sexp))
:version "24.1")
(defcustom vc-git-commits-coding-system 'utf-8
@@ -208,6 +210,16 @@ toggle display of the entire list."
widget))))
:version "27.1")
+(defcustom vc-git-revision-complete-only-branches nil
+ "Control whether tags are returned by revision completion for Git.
+
+When non-nil, only branches and remotes will be returned by
+`vc-git-revision-completion-table'. This is used by various VC
+commands when completing branch names. When nil, tags are also
+included in the completions."
+ :type 'boolean
+ :version "28.1")
+
;; History of Git commands.
(defvar vc-git-history nil)
@@ -241,7 +253,7 @@ toggle display of the entire list."
;; path specs.
;; See also: http://marc.info/?l=git&m=125787684318129&w=2
(name (file-relative-name file dir))
- (str (ignore-errors
+ (str (with-demoted-errors "Error: %S"
(cd dir)
(vc-git--out-ok "ls-files" "-c" "-z" "--" name)
;; If result is empty, use ls-tree to check for deleted
@@ -733,6 +745,7 @@ or an empty string if none."
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
(stash-list (vc-git-stash-list))
+ (default-directory dir)
branch remote remote-url stash-button stash-string)
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
@@ -745,14 +758,8 @@ or an empty string if none."
(concat "branch." branch ".remote")))))
(when (string-match "\\([^\n]+\\)" remote)
(setq remote (match-string 1 remote)))
- (when remote
- (setq remote-url
- (with-output-to-string
- (with-current-buffer standard-output
- (vc-git--out-ok "config"
- (concat "remote." remote ".url"))))))
- (when (string-match "\\([^\n]+\\)" remote-url)
- (setq remote-url (match-string 1 remote-url))))
+ (when (> (length remote) 0)
+ (setq remote-url (vc-git-repository-url dir remote))))
(setq branch "not (detached HEAD)"))
(when stash-list
(let* ((len (length stash-list))
@@ -807,7 +814,7 @@ or an empty string if none."
(propertize "Branch : " 'face 'font-lock-type-face)
(propertize branch
'face 'font-lock-variable-name-face)
- (when remote
+ (when remote-url
(concat
"\n"
(propertize "Remote : " 'face 'font-lock-type-face)
@@ -819,10 +826,10 @@ or an empty string if none."
(when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir)))
(propertize "\nRebase : in progress" 'face 'font-lock-warning-face))
(if stash-list
- (concat
- (propertize "\nStash : " 'face 'font-lock-type-face)
- stash-button
- stash-string)
+ (concat
+ (propertize "\nStash : " 'face 'font-lock-type-face)
+ stash-button
+ stash-string)
(concat
(propertize "\nStash : " 'face 'font-lock-type-face)
(propertize "Nothing stashed"
@@ -1081,6 +1088,13 @@ This prompts for a branch to merge from."
"DU" "AA" "UU"))
(push (expand-file-name file directory) files)))))))
+(defun vc-git-repository-url (file-or-dir &optional remote-name)
+ (let ((default-directory (vc-git-root file-or-dir)))
+ (with-temp-buffer
+ (vc-git-command (current-buffer) 0 nil "remote" "get-url"
+ (or remote-name "origin"))
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
+
;; Everywhere but here, follows vc-git-command, which uses vc-do-command
;; from vc-dispatcher.
(autoload 'vc-resynch-buffer "vc-dispatcher")
@@ -1233,7 +1247,7 @@ log entries."
(set (make-local-variable 'log-view-message-re)
(if (not (memq vc-log-view-type '(long log-search with-diff)))
(cadr vc-git-root-log-format)
- "^commit *\\([0-9a-z]+\\)"))
+ "^commit +\\([0-9a-z]+\\)"))
;; Allow expanding short log entries.
(when (memq vc-log-view-type '(short log-outgoing log-incoming mergebase))
(setq truncate-lines t)
@@ -1262,7 +1276,7 @@ log entries."
("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
(1 'change-log-acknowledgment)
(2 'change-log-acknowledgment))
- ("^Date: \\(.+\\)" (1 'change-log-date))
+ ("^\\(?:Date: \\|AuthorDate: \\)\\(.+\\)" (1 'change-log-date))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
@@ -1411,9 +1425,11 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(with-temp-buffer
(vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
(goto-char (point-min))
- (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"
- nil t)
- (push (match-string 2) table)))
+ (let ((regexp (if vc-git-revision-complete-only-branches
+ "^refs/\\(heads\\|remotes\\)/\\(.*\\)$"
+ "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$")))
+ (while (re-search-forward regexp nil t)
+ (push (match-string 2) table))))
table))
(defun vc-git-revision-completion-table (files)
@@ -1530,6 +1546,9 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(defun vc-git-rename-file (old new)
(vc-git-command nil 0 (list old new) "mv" "-f" "--"))
+(defun vc-git-mark-resolved (files)
+ (vc-git-command nil 0 files "add"))
+
(defvar vc-git-extra-menu-map
(let ((map (make-sparse-keymap)))
(define-key map [git-grep]
@@ -1554,8 +1573,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(defun vc-git-extra-status-menu () vc-git-extra-menu-map)
(defun vc-git-root (file)
- (or (vc-file-getprop file 'git-root)
- (vc-file-setprop file 'git-root (vc-find-root file ".git"))))
+ (vc-find-root file ".git"))
;; grep-compute-defaults autoloads grep.
(declare-function grep-read-regexp "grep" ())
@@ -1688,12 +1706,13 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(vc-resynch-buffer (vc-git-root default-directory) t t))
(defun vc-git-stash-list ()
- (delete
- ""
- (split-string
- (replace-regexp-in-string
- "^stash@" " " (vc-git--run-command-string nil "stash" "list"))
- "\n")))
+ (when-let ((out (vc-git--run-command-string nil "stash" "list")))
+ (delete
+ ""
+ (split-string
+ (replace-regexp-in-string
+ "^stash@" " " out)
+ "\n"))))
(defun vc-git-stash-get-at-point (point)
(save-excursion
@@ -1775,9 +1794,9 @@ The difference to vc-do-command is that this function always invokes
(defun vc-git--call (buffer command &rest args)
;; We don't need to care the arguments. If there is a file name, it
;; is always a relative one. This works also for remote
- ;; directories. We enable `inhibit-nul-byte-detection', otherwise
+ ;; directories. We enable `inhibit-null-byte-detection', otherwise
;; Tramp's eol conversion might be confused.
- (let ((inhibit-nul-byte-detection t)
+ (let ((inhibit-null-byte-detection t)
(coding-system-for-read
(or coding-system-for-read vc-git-log-output-coding-system))
(coding-system-for-write
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index d00b69c0d08..67e129044c0 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -182,10 +182,20 @@ is the \"--template\" argument string to pass to Mercurial,
REGEXP is a regular expression matching the resulting Mercurial
output, and KEYWORDS is a list of `font-lock-keywords' for
highlighting the Log View buffer."
- :type '(list string string (repeat sexp))
+ :type '(list string regexp (repeat sexp))
:group 'vc-hg
:version "24.5")
+(defcustom vc-hg-create-bookmark t
+ "This controls whether `vc-create-tag' will create a bookmark or branch.
+If nil, named branch will be created.
+If t, bookmark will be created.
+If `ask', you will be prompted for a branch type."
+ :type '(choice (const :tag "No" nil)
+ (const :tag "Yes" t)
+ (const :tag "Ask" ask))
+ :version "28.1")
+
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
@@ -212,8 +222,11 @@ highlighting the Log View buffer."
(defun vc-hg-registered (file)
"Return non-nil if FILE is registered with hg."
(when (vc-hg-root file) ; short cut
- (let ((state (vc-hg-state file))) ; expensive
- (and state (not (memq state '(ignored unregistered)))))))
+ (let ((state (vc-state file 'Hg))) ; expensive
+ (if (memq state '(ignored unregistered nil))
+ ;; Clear the cache for proper fallback to another backend.
+ (ignore (vc-file-setprop file 'vc-state nil))
+ t))))
(defun vc-hg-state (file)
"Hg-specific version of `vc-state'."
@@ -625,10 +638,18 @@ Optional arg REVISION is a revision to annotate from."
;;; Tag system
(defun vc-hg-create-tag (dir name branchp)
- "Attach the tag NAME to the state of the working copy."
+ "Create tag NAME in repo in DIR. Create branch if BRANCHP.
+Variable `vc-hg-create-bookmark' controls what kind of branch will be created."
(let ((default-directory dir))
- (and (vc-hg-command nil 0 nil "status")
- (vc-hg-command nil 0 nil (if branchp "bookmark" "tag") name))))
+ (vc-hg-command nil 0 nil
+ (if branchp
+ (if (if (eq vc-hg-create-bookmark 'ask)
+ (yes-or-no-p "Create bookmark instead of branch? ")
+ vc-hg-create-bookmark)
+ "bookmark"
+ "branch")
+ "tag")
+ name)))
(defun vc-hg-retrieve-tag (dir name _update)
"Retrieve the version tagged by NAME of all registered files at or below DIR."
@@ -1366,25 +1387,28 @@ REV is the revision to check out into WORKFILE."
(vc-run-delayed
(vc-hg-after-dir-status update-function)))
-(defun vc-hg-dir-extra-header (name &rest commands)
- (concat (propertize name 'face 'font-lock-type-face)
- (propertize
- (with-temp-buffer
- (apply 'vc-hg-command (current-buffer) 0 nil commands)
- (buffer-substring-no-properties (point-min) (1- (point-max))))
- 'face 'font-lock-variable-name-face)))
-
(defun vc-hg-dir-extra-headers (dir)
- "Generate extra status headers for a Mercurial tree."
+ "Generate extra status headers for a repository in DIR.
+This runs the command \"hg summary\"."
(let ((default-directory dir))
- (concat
- (vc-hg-dir-extra-header "Root : " "root") "\n"
- (vc-hg-dir-extra-header "Branch : " "id" "-b") "\n"
- (vc-hg-dir-extra-header "Tags : " "id" "-t") ; "\n"
- ;; these change after each commit
- ;; (vc-hg-dir-extra-header "Local num : " "id" "-n") "\n"
- ;; (vc-hg-dir-extra-header "Global id : " "id" "-i")
- )))
+ (with-temp-buffer
+ (vc-hg-command t 0 nil "summary")
+ (goto-char (point-min))
+ (mapconcat
+ #'identity
+ (let (result)
+ (while (not (eobp))
+ (push
+ (let ((entry (if (looking-at "\\([^ ].*\\): \\(.*\\)")
+ (cons (capitalize (match-string 1)) (match-string 2))
+ (cons "" (buffer-substring (point) (line-end-position))))))
+ (concat
+ (propertize (format "%-11s: " (car entry)) 'face 'font-lock-type-face)
+ (propertize (cdr entry) 'face 'font-lock-variable-name-face)))
+ result)
+ (forward-line))
+ (nreverse result))
+ "\n"))))
(defun vc-hg-log-incoming (buffer remote-location)
(vc-setup-buffer buffer)
@@ -1525,6 +1549,14 @@ This function differs from vc-do-command in that it invokes
(defun vc-hg-root (file)
(vc-find-root file ".hg"))
+(defun vc-hg-repository-url (file-or-dir &optional remote-name)
+ (let ((default-directory (vc-hg-root file-or-dir)))
+ (with-temp-buffer
+ (vc-hg-command (current-buffer) 0 nil
+ "config"
+ (concat "paths." (or remote-name "default")))
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
+
(provide 'vc-hg)
;;; vc-hg.el ends here
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 345a28d3f1d..f09ceddcb37 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -498,21 +498,13 @@ status of this file. Otherwise, the value returned is one of:
"Return the repository version from which FILE was checked out.
If FILE is not registered, this function always returns nil."
(or (vc-file-getprop file 'vc-working-revision)
- (progn
+ (let ((default-directory (file-name-directory file)))
(setq backend (or backend (vc-backend file)))
(when backend
(vc-file-setprop file 'vc-working-revision
(vc-call-backend
backend 'working-revision file))))))
-;; Backward compatibility.
-(define-obsolete-function-alias
- 'vc-workfile-version 'vc-working-revision "23.1")
-(defun vc-default-working-revision (backend file)
- (message
- "`working-revision' not found: using the old `workfile-version' instead")
- (vc-call-backend backend 'workfile-version file))
-
(defun vc-default-registered (backend file)
"Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
(let ((sym (vc-make-backend-sym backend 'master-templates)))
@@ -972,9 +964,9 @@ In the latter case, VC mode is deactivated for this buffer."
(bindings--define-key map [vc-ignore]
'(menu-item "Ignore File..." vc-ignore
:help "Ignore a file under current version control system"))
- (bindings--define-key map [vc-dir]
- '(menu-item "VC Dir" vc-dir
- :help "Show the VC status of files in a directory"))
+ (bindings--define-key map [vc-dir-root]
+ '(menu-item "VC Dir" vc-dir-root
+ :help "Show the VC status of the repository"))
map))
(defalias 'vc-menu-map vc-menu-map)
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 092d8b53968..3c26ffc0e58 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -60,7 +60,6 @@ switches."
:version "25.1"
:group 'vc-mtn)
-(define-obsolete-variable-alias 'vc-mtn-command 'vc-mtn-program "23.1")
(defcustom vc-mtn-program "mtn"
"Name of the monotone executable."
:type 'string
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 273f37c10d6..23f088b0cff 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -312,7 +312,7 @@ whether to remove it."
(and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
;; check whether RCS dir is empty, i.e. it does not
;; contain any files except "." and ".."
- (not (directory-files dir nil (rx (or (not ".") "..."))))
+ (not (directory-files dir nil directory-files-no-dot-files-regexp))
(yes-or-no-p (format "Directory %s is empty; remove it? " dir))
(delete-directory dir)))))
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index db127ee726d..4eb638978a9 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -146,6 +146,20 @@ For a description of possible values, see `vc-check-master-templates'."
(progn
(defun vc-src-registered (f) (vc-default-registered 'src f)))
+(defun vc-src--parse-state (out)
+ (when (null (string-match "does not exist or is unreadable" out))
+ (let ((state (aref out 0)))
+ (cond
+ ;; FIXME: What to do about L code?
+ ((eq state ?.) 'up-to-date)
+ ((eq state ?A) 'added)
+ ((eq state ?M) 'edited)
+ ((eq state ?I) 'ignored)
+ ((eq state ?R) 'removed)
+ ((eq state ?!) 'missing)
+ ((eq state ??) 'unregistered)
+ (t 'up-to-date)))))
+
(defun vc-src-state (file)
"SRC-specific version of `vc-state'."
(let*
@@ -163,32 +177,41 @@ For a description of possible values, see `vc-check-master-templates'."
"status" "-a" (file-relative-name file))
(error nil)))))))
(when (eq 0 status)
- (when (null (string-match "does not exist or is unreadable" out))
- (let ((state (aref out 0)))
- (cond
- ;; FIXME: What to do about A and L codes?
- ((eq state ?.) 'up-to-date)
- ((eq state ?A) 'added)
- ((eq state ?M) 'edited)
- ((eq state ?I) 'ignored)
- ((eq state ?R) 'removed)
- ((eq state ?!) 'missing)
- ((eq state ??) 'unregistered)
- (t 'up-to-date)))))))
+ (vc-src--parse-state out))))
(autoload 'vc-expand-dirs "vc")
(defun vc-src-dir-status-files (dir files update-function)
- ;; FIXME: Use one src status -a call for this
- (if (not files) (setq files (vc-expand-dirs (list dir) 'SRC)))
- (let ((result nil))
- (dolist (file files)
- (let ((state (vc-state file))
- (frel (file-relative-name file)))
- (when (and (eq (vc-backend file) 'SRC)
- (not (eq state 'up-to-date)))
- (push (list frel state) result))))
- (funcall update-function result)))
+ (let* ((result nil)
+ (status nil)
+ (default-directory (or dir default-directory))
+ (out
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (setq status
+ (ignore-errors
+ (apply
+ #'process-file vc-src-program nil t nil
+ "status" "-a"
+ (mapcar #'file-relative-name files)))))))
+ dlist)
+ (when (eq 0 status)
+ (dolist (line (split-string out "[\n\r]" t))
+ (let* ((pair (split-string line "[\t]" t))
+ (state (vc-src--parse-state (car pair)))
+ (frel (cadr pair)))
+ (if (file-directory-p frel)
+ (push frel dlist)
+ (when (not (eq state 'up-to-date))
+ (push (list frel state) result)))))
+ (dolist (drel dlist)
+ (let ((dresult (vc-src-dir-status-files
+ (expand-file-name drel) nil #'identity)))
+ (dolist (dres dresult)
+ (push (list (concat (file-name-as-directory drel) (car dres))
+ (cadr dres))
+ result))))
+ (funcall update-function result))))
(defun vc-src-command (buffer file-or-list &rest flags)
"A wrapper around `vc-do-command' for use in vc-src.el.
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index d039bf3c6a3..06dd09490d2 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -51,8 +51,8 @@
:group 'vc-svn)
;; Might be nice if svn defaulted to non-interactive if stdin not tty.
-;; http://svn.haxx.se/dev/archive-2008-05/0762.shtml
-;; http://svn.haxx.se/dev/archive-2009-04/0094.shtml
+;; https://svn.haxx.se/dev/archive-2008-05/0762.shtml
+;; https://svn.haxx.se/dev/archive-2009-04/0094.shtml
;; Maybe newer ones do?
(defcustom vc-svn-global-switches (unless (eq system-type 'darwin) ; bug#13513
'("--non-interactive"))
@@ -816,7 +816,14 @@ Set file properties accordingly. If FILENAME is non-nil, return its status."
(push (match-string 1 loglines) vc-svn-revisions)
(setq start (+ start (match-end 0)))
(setq loglines (buffer-substring-no-properties start (point-max)))))
- vc-svn-revisions)))
+ vc-svn-revisions)))
+
+(defun vc-svn-repository-url (file-or-dir &optional _remote-name)
+ (let ((default-directory (vc-svn-root file-or-dir)))
+ (with-temp-buffer
+ (vc-svn-command (current-buffer) 0 nil
+ "info" "--show-item" "repos-root-url")
+ (buffer-substring-no-properties (point-min) (1- (point-max))))))
(provide 'vc-svn)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index fe666413168..83f2596865f 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -553,6 +553,13 @@
;; Return the list of files where conflict resolution is needed in
;; the project that contains DIR.
;; FIXME: what should it do with non-text conflicts?
+;;
+;; - repository-url (file-or-dir &optional remote-name)
+;;
+;; Returns the URL of the repository of the current checkout
+;; containing FILE-OR-DIR. The optional REMOTE-NAME specifies the
+;; remote (in Git parlance) whose URL is to be returned. It has
+;; only a meaning for distributed VCS and is ignored otherwise.
;;; Changes from the pre-25.1 API:
;;
@@ -957,7 +964,7 @@ use."
(throw 'found bk))))
;;;###autoload
-(defun vc-responsible-backend (file)
+(defun vc-responsible-backend (file &optional no-error)
"Return the name of a backend system that is responsible for FILE.
If FILE is already registered, return the
@@ -967,15 +974,29 @@ responsible for FILE is returned.
Note that if FILE is a symbolic link, it will not be resolved --
the responsible backend system for the symbolic link itself will
-be reported."
+be reported.
+
+If NO-ERROR is nil, signal an error that no VC backend is
+responsible for the given file."
(or (and (not (file-directory-p file)) (vc-backend file))
- (catch 'found
- ;; First try: find a responsible backend. If this is for registration,
- ;; it must be a backend under which FILE is not yet registered.
- (dolist (backend vc-handled-backends)
- (and (vc-call-backend backend 'responsible-p file)
- (throw 'found backend))))
- (error "No VC backend is responsible for %s" file)))
+ ;; First try: find a responsible backend. If this is for registration,
+ ;; it must be a backend under which FILE is not yet registered.
+ (let ((dirs (delq nil
+ (mapcar
+ (lambda (backend)
+ (when-let ((dir (vc-call-backend
+ backend 'responsible-p file)))
+ (cons backend dir)))
+ vc-handled-backends))))
+ ;; Just a single response (or none); use it.
+ (if (< (length dirs) 2)
+ (caar dirs)
+ ;; Several roots; we seem to have one vc inside another's
+ ;; directory. Choose the most specific.
+ (caar (sort dirs (lambda (d1 d2)
+ (< (length (cdr d2)) (length (cdr d1))))))))
+ (unless no-error
+ (error "No VC backend is responsible for %s" file))))
(defun vc-expand-dirs (file-or-dir-list backend)
"Expands directories in a file list specification.
@@ -1006,35 +1027,57 @@ Within directories, only files already under version control are noticed."
(declare-function vc-dir-current-file "vc-dir" ())
(declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files))
+(declare-function dired-vc-deduce-fileset "dired-aux" (&optional state-model-only-files not-state-changing))
-(defun vc-deduce-fileset (&optional observer allow-unregistered
+(defun vc-deduce-fileset (&optional not-state-changing
+ allow-unregistered
state-model-only-files)
"Deduce a set of files and a backend to which to apply an operation.
-Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL).
+Return a list of the form:
+
+ (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL)
+
+where the last 3 members are optional, and must be present only if
+STATE-MODEL-ONLY-FILES is non-nil.
+
+NOT-STATE-CHANGING, if non-nil, means that the operation
+requesting the fileset doesn't intend to change the VC state,
+such as when printing the log or showing the diffs.
-If we're in VC-dir mode, FILESET is the list of marked files,
-or the directory if no files are marked.
-Otherwise, if in a buffer visiting a version-controlled file,
-FILESET is a single-file fileset containing that file.
+If the current buffer is in `vc-dir' or Dired mode, FILESET is the
+list of marked files, or the file under point if no files are
+marked.
+Otherwise, if the current buffer is visiting a version-controlled
+file or is an indirect buffer whose base buffer visits a
+version-controlled file, FILESET is a single-file list containing
+that file's name.
Otherwise, if ALLOW-UNREGISTERED is non-nil and the visited file
-is unregistered, FILESET is a single-file fileset containing it.
+is unregistered, FILESET is a single-file list containing the
+name of the visited file.
Otherwise, throw an error.
-STATE-MODEL-ONLY-FILES if non-nil, means that the caller needs
-the FILESET-ONLY-FILES STATE and MODEL info. Otherwise, that
-part may be skipped.
+STATE-MODEL-ONLY-FILES, if non-nil, means that the caller needs
+the FILESET-ONLY-FILES, STATE, and CHECKOUT-MODEL info, where
+FILESET-ONLY-FILES means only files in similar VC states,
+possible values of STATE are explained in `vc-state', and MODEL in
+`vc-checkout-model'. Otherwise, these 3 members may be omitted from
+the returned list.
BEWARE: this function may change the current buffer."
- ;; FIXME: OBSERVER is unused. The name is not intuitive and is not
- ;; documented. It's set to t when called from diff and print-log.
+ (with-current-buffer (or (buffer-base-buffer) (current-buffer))
+ (vc-deduce-fileset-1 not-state-changing
+ allow-unregistered
+ state-model-only-files)))
+
+(defun vc-deduce-fileset-1 (not-state-changing
+ allow-unregistered
+ state-model-only-files)
(let (backend)
(cond
((derived-mode-p 'vc-dir-mode)
(vc-dir-deduce-fileset state-model-only-files))
((derived-mode-p 'dired-mode)
- (if observer
- (vc-dired-deduce-fileset)
- (error "State changing VC operations not supported in `dired-mode'")))
+ (dired-vc-deduce-fileset state-model-only-files not-state-changing))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
(list backend (list buffer-file-name)
@@ -1046,15 +1089,14 @@ BEWARE: this function may change the current buffer."
;; FIXME: Why this test? --Stef
(or (buffer-file-name vc-parent-buffer)
(with-current-buffer vc-parent-buffer
- (derived-mode-p 'vc-dir-mode))))
+ (or (derived-mode-p 'vc-dir-mode)
+ (derived-mode-p 'dired-mode)))))
(progn ;FIXME: Why not `with-current-buffer'? --Stef.
(set-buffer vc-parent-buffer)
- (vc-deduce-fileset observer allow-unregistered state-model-only-files)))
- ((and (derived-mode-p 'log-view-mode)
+ (vc-deduce-fileset-1 not-state-changing allow-unregistered state-model-only-files)))
+ ((and (not buffer-file-name)
(setq backend (vc-responsible-backend default-directory)))
(list backend nil))
- ((not buffer-file-name)
- (error "Buffer %s is not associated with a file" (buffer-name)))
((and allow-unregistered (not (vc-registered buffer-file-name)))
(if state-model-only-files
(list (vc-backend-for-registration (buffer-file-name))
@@ -1066,10 +1108,6 @@ BEWARE: this function may change the current buffer."
(list buffer-file-name))))
(t (error "File is not under version control")))))
-(defun vc-dired-deduce-fileset ()
- (list (vc-responsible-backend default-directory)
- (dired-map-over-marks (dired-get-filename nil t) nil)))
-
(defun vc-ensure-vc-buffer ()
"Make sure that the current buffer visits a version-controlled file."
(cond
@@ -1328,8 +1366,6 @@ For old-style locking-based version control systems, like RCS:
nil t)))))
(vc-call-backend backend 'create-repo))
-(declare-function vc-dir-move-to-goal-column "vc-dir" ())
-
;;;###autoload
(defun vc-register (&optional vc-fileset comment)
"Register into a version control system.
@@ -1355,7 +1391,7 @@ first backend that could register the file is used."
(unless fname
(setq fname buffer-file-name))
(when (vc-call-backend backend 'registered fname)
- (error "This file is already registered"))
+ (error "This file is already registered: %s" fname))
;; Watch out for new buffers of size 0: the corresponding file
;; does not exist yet, even though buffer-modified-p is nil.
(when bname
@@ -1380,8 +1416,6 @@ first backend that could register the file is used."
(vc-resynch-buffer file t t))
files)
- (when (derived-mode-p 'vc-dir-mode)
- (vc-dir-move-to-goal-column))
(message "Registering %s... done" files)))
(defun vc-register-with (backend)
@@ -1869,6 +1903,10 @@ state of each file in the fileset."
t (list backend (list rootdir)) rev1 rev2
(called-interactively-p 'interactive)))))
+(defun vc-maybe-buffer-sync (not-urgent)
+ (with-current-buffer (or (buffer-base-buffer) (current-buffer))
+ (when buffer-file-name (vc-buffer-sync not-urgent))))
+
;;;###autoload
(defun vc-diff (&optional historic not-urgent)
"Display diffs between file revisions.
@@ -1881,9 +1919,17 @@ saving the buffer."
(interactive (list current-prefix-arg t))
(if historic
(call-interactively 'vc-version-diff)
- (when buffer-file-name (vc-buffer-sync not-urgent))
- (vc-diff-internal t (vc-deduce-fileset t) nil nil
- (called-interactively-p 'interactive))))
+ (vc-maybe-buffer-sync not-urgent)
+ (let ((fileset (vc-deduce-fileset t)))
+ (vc-buffer-sync-fileset fileset not-urgent)
+ (vc-diff-internal t fileset nil nil
+ (called-interactively-p 'interactive)))))
+
+(defun vc-buffer-sync-fileset (fileset not-urgent)
+ (dolist (filename (cadr fileset))
+ (when-let ((buffer (find-buffer-visiting filename)))
+ (with-current-buffer buffer
+ (vc-buffer-sync not-urgent)))))
;;;###autoload
(defun vc-diff-mergebase (_files rev1 rev2)
@@ -1960,7 +2006,7 @@ saving the buffer."
(interactive (list current-prefix-arg t))
(if historic
(call-interactively 'vc-version-ediff)
- (when buffer-file-name (vc-buffer-sync not-urgent))
+ (vc-maybe-buffer-sync not-urgent)
(vc-version-ediff (cadr (vc-deduce-fileset t)) nil nil)))
;;;###autoload
@@ -1977,7 +2023,7 @@ saving the buffer."
(if historic
;; We want the diff for the VC root dir.
(call-interactively 'vc-root-version-diff)
- (when buffer-file-name (vc-buffer-sync not-urgent))
+ (vc-maybe-buffer-sync not-urgent)
(let ((backend (vc-deduce-backend))
(default-directory default-directory)
rootdir working-revision)
@@ -2017,16 +2063,17 @@ Return nil if the root directory cannot be identified."
If the current file is named `F', the revision is named `F.~REV~'.
If `F.~REV~' already exists, use it instead of checking it out again."
(interactive
- (save-current-buffer
+ (with-current-buffer (or (buffer-base-buffer) (current-buffer))
(vc-ensure-vc-buffer)
(list
(vc-read-revision "Revision to visit (default is working revision): "
(list buffer-file-name)))))
+ (set-buffer (or (buffer-base-buffer) (current-buffer)))
(vc-ensure-vc-buffer)
(let* ((file buffer-file-name)
(revision (if (string-equal rev "")
- (vc-working-revision file)
- rev)))
+ (vc-working-revision file)
+ rev)))
(switch-to-buffer-other-window (vc-find-revision file revision))))
(defun vc-find-revision (file revision &optional backend)
@@ -2502,11 +2549,8 @@ with its diffs (if the underlying VCS supports that)."
(cond
((eq current-prefix-arg 1)
(let* ((default (thing-at-point 'word t))
- (revision (read-string
- (if default
- (format "Revision to show (default %s): " default)
- "Revision to show: ")
- nil nil default)))
+ (revision (read-string (format-prompt "Revision to show" default)
+ nil nil default)))
(list 1 revision)))
((numberp current-prefix-arg)
(list current-prefix-arg))
@@ -2537,15 +2581,17 @@ with its diffs (if the underlying VCS supports that)."
;;;###autoload
(defun vc-print-branch-log (branch)
- "Show the change log for BRANCH in a window."
+ "Show the change log for BRANCH root in a window."
(interactive
(list
(vc-read-revision "Branch to log: ")))
(when (equal branch "")
(error "No branch specified"))
- (vc-print-log-internal (vc-responsible-backend default-directory)
- (list default-directory) branch t
- (when (> vc-log-show-limit 0) vc-log-show-limit)))
+ (let* ((backend (vc-responsible-backend default-directory))
+ (rootdir (vc-call-backend backend 'root default-directory)))
+ (vc-print-log-internal backend
+ (list rootdir) branch t
+ (when (> vc-log-show-limit 0) vc-log-show-limit))))
;;;###autoload
(defun vc-log-incoming (&optional remote-location)
@@ -2690,9 +2736,6 @@ to the working revision (except for keyword expansion)."
(message "Reverting %s...done" (vc-delistify files)))))
;;;###autoload
-(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
-
-;;;###autoload
(defun vc-pull (&optional arg)
"Update the current fileset or branch.
You must be visiting a version controlled file, or in a `vc-dir' buffer.
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index fa0cbb74b0d..e5e9f062a92 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -602,15 +602,14 @@ Set `vcursor-window' to the returned value as a side effect."
(pos-visible-in-window-p (point) vcursor-window))
(progn
(walk-windows
- (function
- (lambda (win)
- (and (not winok)
- (eq (current-buffer) (window-buffer win))
- (not (and not-this (eq thiswin win)))
- (cond
- ((pos-visible-in-window-p (point) win) (setq winok win))
- ((eq thiswin win))
- ((not winbuf) (setq winbuf win))))))
+ (lambda (win)
+ (and (not winok)
+ (eq (current-buffer) (window-buffer win))
+ (not (and not-this (eq thiswin win)))
+ (cond
+ ((pos-visible-in-window-p (point) win) (setq winok win))
+ ((eq thiswin win))
+ ((not winbuf) (setq winbuf win)))))
nil (not this-frame))
(setq vcursor-window
(cond
@@ -1132,9 +1131,6 @@ line is treated like ordinary characters."
(vcursor-copy (if (or (= count 0) arg) (1+ count) count)))
)
-(define-obsolete-function-alias
- 'vcursor-toggle-vcursor-map 'vcursor-use-vcursor-map "23.1")
-
(defun vcursor-post-command ()
(and vcursor-auto-disable (not vcursor-last-command)
vcursor-overlay
diff --git a/lisp/version.el b/lisp/version.el
index bf666cbff99..b247232dcfd 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -1,4 +1,4 @@
-;;; version.el --- record version number of Emacs
+;;; version.el --- record version number of Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1985, 1992, 1994-1995, 1999-2020 Free Software
;; Foundation, Inc.
@@ -123,7 +123,7 @@ or if we could not determine the revision.")
(looking-at "[[:xdigit:]]\\{40\\}"))
(match-string 0)))))
-(defun emacs-repository-get-version (&optional dir external)
+(defun emacs-repository-get-version (&optional dir _external)
"Try to return as a string the repository revision of the Emacs sources.
The format of the returned string is dependent on the VCS in use.
Value is nil if the sources do not seem to be under version
diff --git a/lisp/vt-control.el b/lisp/vt-control.el
index fc3a514f921..d4c14197bdc 100644
--- a/lisp/vt-control.el
+++ b/lisp/vt-control.el
@@ -1,4 +1,4 @@
-;;; vt-control.el --- Common VTxxx control functions
+;;; vt-control.el --- Common VTxxx control functions -*- lexical-binding:t -*-
;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el
index 7552fbb99c1..1e81dd241f1 100644
--- a/lisp/vt100-led.el
+++ b/lisp/vt100-led.el
@@ -1,4 +1,4 @@
-;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones
+;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones -*- lexical-binding:t -*-
;; Copyright (C) 1988, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 8a816da1f2c..e159d1888e5 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -202,8 +202,7 @@ This function is provided for backward compatibility, since
(interactive
(list (let ((default locale-coding-system))
(read-coding-system
- (format "Coding system for system calls (default %s): "
- default)
+ (format-prompt "Coding system for system calls" default)
default))))
(check-coding-system coding-system)
(setq locale-coding-system coding-system))
@@ -238,14 +237,18 @@ bit output with no translation."
;; value from x-select-font etc, so list the most important charsets last.
(w32-add-charset-info "iso8859-14" 'w32-charset-ansi 28604)
(w32-add-charset-info "iso8859-15" 'w32-charset-ansi 28605)
+ (w32-add-charset-info "iso8859-16" 'w32-charset-ansi 28606)
;; The following two are included for pattern matching.
(w32-add-charset-info "jisx0201" 'w32-charset-shiftjis 932)
(w32-add-charset-info "jisx0208" 'w32-charset-shiftjis 932)
(w32-add-charset-info "jisx0201-latin" 'w32-charset-shiftjis 932)
(w32-add-charset-info "jisx0201-katakana" 'w32-charset-shiftjis 932)
+ (w32-add-charset-info "jisx0212" 'w32-charset-shiftjis 932)
(w32-add-charset-info "ksc5601.1989" 'w32-charset-hangeul 949)
+ (w32-add-charset-info "ksx1001" 'w32-charset-hangeul 949)
(w32-add-charset-info "big5" 'w32-charset-chinesebig5 950)
(w32-add-charset-info "gb2312.1980" 'w32-charset-gb2312 936)
+ (w32-add-charset-info "gbk" 'w32-charset-gb2312 936)
(w32-add-charset-info "ms-symbol" 'w32-charset-symbol nil)
(w32-add-charset-info "ms-oem" 'w32-charset-oem 437)
(w32-add-charset-info "ms-oemlatin" 'w32-charset-oem 850)
@@ -258,9 +261,12 @@ bit output with no translation."
(w32-add-charset-info "iso8859-9" 'w32-charset-turkish 1254)
(w32-add-charset-info "iso8859-13" 'w32-charset-baltic 1257)
(w32-add-charset-info "koi8-r" 'w32-charset-russian 20866)
+ (w32-add-charset-info "microsoft-cp1251" 'w32-charset-russian 1251)
+ (w32-add-charset-info "windows-1251" 'w32-charset-russian 1251)
(w32-add-charset-info "tis620-2533" 'w32-charset-russian 28595)
(w32-add-charset-info "iso8859-11" 'w32-charset-thai 874)
(w32-add-charset-info "windows-1258" 'w32-charset-vietnamese 1258)
+ (w32-add-charset-info "viscii" 'w32-charset-vietnamese 1258)
(w32-add-charset-info "ksc5601.1992" 'w32-charset-johab 1361)
(w32-add-charset-info "mac-roman" 'w32-charset-mac 10000)
(w32-add-charset-info "iso10646-1" 'w32-charset-default t)
diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el
index 307490dc4b0..642a48446ef 100644
--- a/lisp/w32-vars.el
+++ b/lisp/w32-vars.el
@@ -1,4 +1,4 @@
-;;; w32-vars.el --- MS-Windows specific user options
+;;; w32-vars.el --- MS-Windows specific user options -*- lexical-binding:t -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@@ -44,22 +44,19 @@ after changing the value of this variable."
:type 'boolean
:set (lambda (symbol value)
(set symbol value)
- (setq mouse-appearance-menu-map nil))
- :group 'w32)
+ (setq mouse-appearance-menu-map nil)))
(unless (eq system-type 'cygwin)
(defcustom w32-allow-system-shell nil
"Disable startup warning when using \"system\" shells."
- :type 'boolean
- :group 'w32))
+ :type 'boolean))
(unless (eq system-type 'cygwin)
(defcustom w32-system-shells '("cmd" "cmd.exe" "command" "command.com"
"4nt" "4nt.exe" "4dos" "4dos.exe"
"tcc" "tcc.exe" "ndos" "ndos.exe")
"List of strings recognized as Windows system shells."
- :type '(repeat string)
- :group 'w32))
+ :type '(repeat string)))
;; Want "menu" custom type for this.
(defcustom w32-fixed-font-alist
@@ -149,8 +146,7 @@ menu if the variable `w32-use-w32-font-dialog' is nil."
(const :tag "Separator" (""))
(list :tag "Font Entry"
(string :tag "Menu text")
- (string :tag "Font")))))))
- :group 'w32)
+ (string :tag "Font"))))))))
(make-obsolete-variable 'w32-enable-synthesized-fonts nil "24.4")
diff --git a/lisp/wdired.el b/lisp/wdired.el
index d91853e64dd..bb32da3e3a2 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -4,7 +4,7 @@
;; Filename: wdired.el
;; Author: Juan León Lahoz García <juanleon1@gmail.com>
-;; Version: 2.0
+;; Old-Version: 2.0
;; Keywords: dired, environment, files, renaming
;; This file is part of GNU Emacs.
@@ -255,7 +255,7 @@ See `wdired-mode'."
(setq buffer-read-only nil)
(dired-unadvertise default-directory)
(add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
- (add-hook 'after-change-functions 'wdired--restore-dired-filename-prop nil t)
+ (add-hook 'after-change-functions 'wdired--restore-properties nil t)
(setq major-mode 'wdired-mode)
(setq mode-name "Editable Dired")
(setq revert-buffer-function 'wdired-revert)
@@ -266,7 +266,7 @@ See `wdired-mode'."
(wdired-preprocess-files)
(if wdired-allow-to-change-permissions
(wdired-preprocess-perms))
- (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
+ (if (fboundp 'make-symbolic-link)
(wdired-preprocess-symlinks))
(buffer-enable-undo) ; Performance hack. See above.
(set-buffer-modified-p nil)
@@ -288,6 +288,7 @@ or \\[wdired-abort-changes] to abort changes")))
(save-excursion
(goto-char (point-min))
(let ((b-protection (point))
+ (used-F (dired-check-switches dired-actual-switches "F" "classify"))
filename)
(while (not (eobp))
(setq filename (dired-get-filename nil t))
@@ -299,8 +300,16 @@ or \\[wdired-abort-changes] to abort changes")))
(add-text-properties
(1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
(put-text-property b-protection (point) 'read-only t)
- (setq b-protection (dired-move-to-end-of-filename t))
+ (dired-move-to-end-of-filename t)
(put-text-property (point) (1+ (point)) 'end-name t))
+ (when (and used-F (looking-at "[*/@|=>]$")) (forward-char))
+ (when (save-excursion
+ (and (re-search-backward
+ dired-permission-flags-regexp nil t)
+ (looking-at "l")
+ (search-forward " -> " (line-end-position) t)))
+ (goto-char (line-end-position)))
+ (setq b-protection (point))
(forward-line))
(put-text-property b-protection (point-max) 'read-only t))))
@@ -327,7 +336,8 @@ relies on WDired buffer's properties. Optional arg NO-DIR with value
non-nil means don't include directory. Optional arg OLD with value
non-nil means return old filename."
;; FIXME: Use dired-get-filename's new properties.
- (let (beg end file)
+ (let ((used-F (dired-check-switches dired-actual-switches "F" "classify"))
+ beg end file)
(save-excursion
(setq end (line-end-position))
(beginning-of-line)
@@ -339,12 +349,25 @@ non-nil means return old filename."
;; the filename end is found even when the filename is empty.
;; Fixes error and spurious newlines when marking files for
;; deletion.
- (setq end (next-single-property-change beg 'end-name))
+ (setq end (next-single-property-change beg 'end-name nil end))
+ (when (save-excursion
+ (and (re-search-forward
+ dired-permission-flags-regexp nil t)
+ (goto-char (match-beginning 0))
+ (looking-at "l")
+ (search-forward " -> " (line-end-position) t)))
+ (goto-char (match-beginning 0))
+ (setq end (point)))
+ (when (and used-F
+ (save-excursion
+ (goto-char end)
+ (looking-back "[*/@|=>]$" (1- (point)))))
+ (setq end (1- end)))
(setq file (buffer-substring-no-properties (1+ beg) end)))
;; Don't unquote the old name, it wasn't quoted in the first place
(and file (setq file (wdired-normalize-filename file (not old)))))
(if (or no-dir old)
- file
+ (if no-dir (file-relative-name file) file)
(and file (> (length file) 0)
(concat (dired-current-directory) file))))))
@@ -366,7 +389,7 @@ non-nil means return old filename."
(setq mode-name "Dired")
(dired-advertise)
(remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
- (remove-hook 'after-change-functions 'wdired--restore-dired-filename-prop t)
+ (remove-hook 'after-change-functions 'wdired--restore-properties t)
(set (make-local-variable 'revert-buffer-function) 'dired-revert))
@@ -427,9 +450,9 @@ non-nil means return old filename."
(when files-renamed
(setq errors (+ errors (wdired-do-renames files-renamed))))
;; We have to be in wdired-mode when wdired-do-renames is executed
- ;; so that wdired--restore-dired-filename-prop runs, but we have
- ;; to change back to dired-mode before reverting the buffer to
- ;; avoid using wdired-revert, which changes back to wdired-mode.
+ ;; so that wdired--restore-properties runs, but we have to change
+ ;; back to dired-mode before reverting the buffer to avoid using
+ ;; wdired-revert, which changes back to wdired-mode.
(wdired-change-to-dired-mode)
(if changes
(progn
@@ -451,20 +474,26 @@ non-nil means return old filename."
'(old-name nil end-name nil old-link nil
end-link nil end-perm nil
old-perm nil perm-changed nil))
- (message "(No changes to be performed)")))
+ (message "(No changes to be performed)")
+ ;; Deleting file indicator characters or editing the symlink
+ ;; arrow in WDired are noops, so redisplay them immediately on
+ ;; returning to Dired.
+ (revert-buffer)))
(when files-deleted
(wdired-flag-for-deletion files-deleted))
(when (> errors 0)
- (dired-log-summary (format "%d rename actions failed" errors) nil)))
+ (dired-log-summary (format "%d actions failed" errors) nil)))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil))
(defun wdired-do-renames (renames)
"Perform RENAMES in parallel."
- (let ((residue ())
- (progress nil)
- (errors 0)
- (overwrite (or (not wdired-confirm-overwrite) 1)))
+ (let* ((residue ())
+ (progress nil)
+ (errors 0)
+ (total (1- (length renames)))
+ (prep (make-progress-reporter "Renaming" 0 total))
+ (overwrite (or (not wdired-confirm-overwrite) 1)))
(while (or renames
;; We've done one round through the renames, we have found
;; some residue, but we also made some progress, so maybe
@@ -472,6 +501,7 @@ non-nil means return old filename."
(prog1 (setq renames residue)
(setq progress nil)
(setq residue nil)))
+ (progress-reporter-update prep (- total (length renames)))
(let* ((rename (pop renames))
(file-new (cdr rename)))
(cond
@@ -519,6 +549,7 @@ non-nil means return old filename."
(dired-log "Rename `%s' to `%s' failed:\n%s\n"
file-ori file-new
err)))))))))
+ (progress-reporter-done prep)
errors))
(defun wdired-create-parentdirs (file-new)
@@ -605,11 +636,24 @@ Optional arguments are ignored."
;; dired-filename text property, which allows functions that look for
;; this property (e.g. dired-isearch-filenames) to work in wdired-mode
;; and also avoids an error with non-nil wdired-use-interactive-rename
-;; (bug#32173).
-(defun wdired--restore-dired-filename-prop (beg end _len)
+;; (bug#32173). Also prevents editing the symlink arrow (which is a
+;; noop) from corrupting the link name (see bug#18475 for elaboration).
+(defun wdired--restore-properties (beg end _len)
(save-match-data
(save-excursion
- (let ((lep (line-end-position)))
+ (let ((lep (line-end-position))
+ (used-F (dired-check-switches
+ dired-actual-switches
+ "F" "classify")))
+ ;; Deleting the space between the link name and the arrow (a
+ ;; noop) also deletes the end-name property, so restore it.
+ (when (and (save-excursion
+ (re-search-backward dired-permission-flags-regexp nil t)
+ (looking-at "l"))
+ (get-text-property (1- (point)) 'dired-filename)
+ (not (get-text-property (point) 'dired-filename))
+ (not (get-text-property (point) 'end-name)))
+ (put-text-property (point) (1+ (point)) 'end-name t))
(beginning-of-line)
(when (re-search-forward
directory-listing-before-filename-regexp lep t)
@@ -623,13 +667,17 @@ Optional arguments are ignored."
(and (re-search-backward
dired-permission-flags-regexp nil t)
(looking-at "l")
- (search-forward " -> " lep t))
+ ;; macOS and Ultrix adds "@" to the end
+ ;; of symlinks when using -F.
+ (if (and used-F
+ dired-ls-F-marks-symlinks)
+ (re-search-forward "@? -> " lep t)
+ (search-forward " -> " lep t)))
;; When dired-listing-switches includes "F"
;; or "classify", don't treat appended
;; indicator characters as part of the file
;; name (bug#34915).
- (and (dired-check-switches dired-actual-switches
- "F" "classify")
+ (and used-F
(re-search-forward "[*/@|=>]$" lep t)))
(goto-char (match-beginning 0))
lep))
@@ -640,6 +688,7 @@ Optional arguments are ignored."
See `wdired-use-dired-vertical-movement'. Optional prefix ARG
says how many lines to move; default is one line."
(interactive "^p")
+ (setq this-command 'next-line) ;Let `line-move' preserve the column.
(with-no-warnings (next-line arg))
(if (or (eq wdired-use-dired-vertical-movement t)
(and wdired-use-dired-vertical-movement
@@ -653,6 +702,7 @@ says how many lines to move; default is one line."
See `wdired-use-dired-vertical-movement'. Optional prefix ARG
says how many lines to move; default is one line."
(interactive "^p")
+ (setq this-command 'previous-line) ;Let `line-move' preserve the column.
(with-no-warnings (previous-line arg))
(if (or (eq wdired-use-dired-vertical-movement t)
(and wdired-use-dired-vertical-movement
@@ -667,33 +717,36 @@ says how many lines to move; default is one line."
(save-excursion
(goto-char (point-min))
(while (not (eobp))
- (if (looking-at dired-re-sym)
- (progn
- (re-search-forward " -> \\(.*\\)$")
- (put-text-property (- (match-beginning 1) 2)
- (1- (match-beginning 1)) 'old-link
- (match-string-no-properties 1))
- (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
- (put-text-property (1- (match-beginning 1))
- (match-beginning 1)
- 'rear-nonsticky '(read-only))
- (put-text-property (match-beginning 1)
- (match-end 1) 'read-only nil)))
+ (when (looking-at dired-re-sym)
+ (re-search-forward " -> \\(.*\\)$")
+ (put-text-property (1- (match-beginning 1))
+ (match-beginning 1) 'old-link
+ (match-string-no-properties 1))
+ (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
+ (unless wdired-allow-to-redirect-links
+ (put-text-property (match-beginning 0)
+ (match-end 1) 'read-only t)))
(forward-line)))))
-
(defun wdired-get-previous-link (&optional old move)
"Return the next symlink target.
If OLD, return the old target. If MOVE, move point before it."
(let (beg end target)
(setq beg (previous-single-property-change (point) 'old-link nil))
- (if beg
- (progn
- (if old
- (setq target (get-text-property (1- beg) 'old-link))
- (setq end (next-single-property-change beg 'end-link))
- (setq target (buffer-substring-no-properties (1+ beg) end)))
- (if move (goto-char (1- beg)))))
+ (when beg
+ (when (save-excursion
+ (goto-char beg)
+ (and (looking-at " ")
+ (looking-back " ->" (line-beginning-position))))
+ (setq beg (1+ beg)))
+ (if old
+ (setq target (get-text-property (1- beg) 'old-link))
+ (setq end (save-excursion
+ (goto-char beg)
+ (next-single-property-change beg 'end-link nil
+ (line-end-position))))
+ (setq target (buffer-substring-no-properties beg end)))
+ (if move (goto-char (1- beg))))
(and target (wdired-normalize-filename target t))))
(declare-function make-symbolic-link "fileio.c")
@@ -858,26 +911,26 @@ Like original function but it skips read-only words."
(mouse-set-point event)
(wdired-toggle-bit))
-;; Allowed chars for 4000 bit are Ss in position 3
-;; Allowed chars for 2000 bit are Ssl in position 6
-;; Allowed chars for 1000 bit are Tt in position 9
+;; Allowed chars for #o4000 bit are Ss in position 3
+;; Allowed chars for #o2000 bit are Ssl in position 6
+;; Allowed chars for #o1000 bit are Tt in position 9
(defun wdired-perms-to-number (perms)
- (let ((nperm 0777))
- (if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
- (if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
+ (let ((nperm #o0777))
+ (if (= (elt perms 1) ?-) (setq nperm (- nperm #o400)))
+ (if (= (elt perms 2) ?-) (setq nperm (- nperm #o200)))
(let ((p-bit (elt perms 3)))
- (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
- (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
- (if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
- (if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
+ (if (memq p-bit '(?- ?S)) (setq nperm (- nperm #o100)))
+ (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm #o4000))))
+ (if (= (elt perms 4) ?-) (setq nperm (- nperm #o40)))
+ (if (= (elt perms 5) ?-) (setq nperm (- nperm #o20)))
(let ((p-bit (elt perms 6)))
- (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
- (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
+ (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm #o10)))
+ (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm #o2000))))
(if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
(if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
(let ((p-bit (elt perms 9)))
(if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
- (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
+ (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm #o1000))))
nperm))
;; Perform the changes in the permissions of the files that have
@@ -887,7 +940,7 @@ Like original function but it skips read-only words."
(errors 0)
(prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced)
'old-perm 'perm-changed))
- filename perms-ori perms-new perm-tmp)
+ filename perms-ori perms-new)
(goto-char (next-single-property-change (point-min) prop-wanted
nil (point-max)))
(while (not (eobp))
@@ -898,14 +951,12 @@ Like original function but it skips read-only words."
(setq changes t)
(setq filename (wdired-get-filename nil t))
(if (= (length perms-new) 10)
- (progn
- (setq perm-tmp
- (int-to-string (wdired-perms-to-number perms-new)))
- (unless (equal 0 (process-file dired-chmod-program
- nil nil nil perm-tmp filename))
- (setq errors (1+ errors))
- (dired-log "%s %s `%s' failed\n\n"
- dired-chmod-program perm-tmp filename)))
+ (condition-case nil
+ (set-file-modes filename (wdired-perms-to-number perms-new))
+ (error
+ (setq errors (1+ errors))
+ (dired-log "Setting mode of `%s' to `%s' failed\n\n"
+ filename perms-new)))
(setq errors (1+ errors))
(dired-log "Cannot parse permission `%s' for file `%s'\n\n"
perms-new filename)))
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index db7c023324b..02ee7bcf7fd 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -5,7 +5,7 @@
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: data, wp
;; Version: 13.2.2
-;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; X-URL: https://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; This file is part of GNU Emacs.
@@ -86,19 +86,6 @@
;; * if global whitespace is turned off, whitespace continues on only
;; in the buffers in which local whitespace is on.
;;
-;; To use whitespace, insert in your ~/.emacs:
-;;
-;; (require 'whitespace)
-;;
-;; Or autoload at least one of the commands`whitespace-mode',
-;; `whitespace-toggle-options', `global-whitespace-mode' or
-;; `global-whitespace-toggle-options'. For example:
-;;
-;; (autoload 'whitespace-mode "whitespace"
-;; "Toggle whitespace visualization." t)
-;; (autoload 'whitespace-toggle-options "whitespace"
-;; "Toggle local `whitespace-mode' options." t)
-;;
;; whitespace was inspired by:
;;
;; whitespace.el Rajesh Vaidheeswarran <rv@gnu.org>
@@ -262,7 +249,7 @@
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; code:
+;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -283,7 +270,8 @@
'(face
tabs spaces trailing lines space-before-tab newline
indentation empty space-after-tab
- space-mark tab-mark newline-mark)
+ space-mark tab-mark newline-mark
+ missing-newline-at-eof)
"Specify which kind of blank is visualized.
It's a list containing some or all of the following values:
@@ -326,6 +314,11 @@ It's a list containing some or all of the following values:
It has effect only if `face' (see above)
is present in `whitespace-style'.
+ missing-newline-at-eof Missing newline at the end of the file is
+ visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
+
empty empty lines at beginning and/or end of buffer
are visualized via faces.
It has effect only if `face' (see above)
@@ -439,6 +432,8 @@ See also `whitespace-display-mappings' for documentation."
(const :tag "(Face) Lines" lines)
(const :tag "(Face) Lines, only overlong part" lines-tail)
(const :tag "(Face) NEWLINEs" newline)
+ (const :tag "(Face) Missing newlines at EOB"
+ missing-newline-at-eof)
(const :tag "(Face) Empty Lines At BOB And/Or EOB" empty)
(const :tag "(Face) Indentation SPACEs" indentation::tab)
(const :tag "(Face) Indentation TABs"
@@ -586,6 +581,10 @@ line. Used when `whitespace-style' includes the value `indentation'.")
"Face used to visualize big indentation."
:group 'whitespace)
+(defface whitespace-missing-newline-at-eof
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "#d0d040" :foreground "black"))
+ "Face used to visualize missing newline at the end of the file.")
(defvar whitespace-empty 'whitespace-empty
"Symbol face used to visualize empty lines at beginning and/or end of buffer.
@@ -717,7 +716,7 @@ and the cons cdr is used for TABs visualization.
Used when `whitespace-style' includes `indentation',
`indentation::tab' or `indentation::space'."
:type '(cons (string :tag "Indentation SPACEs")
- (string :tag "Indentation TABs"))
+ (regexp :tag "Indentation TABs"))
:group 'whitespace)
@@ -1700,6 +1699,8 @@ cleaning up these problems."
(whitespace-space-after-tab-regexp 'tab))
((eq (car option) 'space-after-tab::space)
(whitespace-space-after-tab-regexp 'space))
+ ((eq (car option) 'missing-newline-at-eof)
+ "[^\n]\\'")
(t
(cdr option)))))
(when (re-search-forward regexp rend t)
@@ -2067,16 +2068,7 @@ resultant list will be returned."
,@(when (or (memq 'lines whitespace-active-style)
(memq 'lines-tail whitespace-active-style))
;; Show "long" lines.
- `((,(let ((line-column (or whitespace-line-column fill-column)))
- (format
- "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
- tab-width
- (1- tab-width)
- (/ line-column tab-width)
- (let ((rem (% line-column tab-width)))
- (if (zerop rem)
- ""
- (format ".\\{%d\\}" rem)))))
+ `((,#'whitespace-lines-regexp
,(if (memq 'lines whitespace-active-style)
0 ; whole line
2) ; line tail
@@ -2131,7 +2123,16 @@ resultant list will be returned."
((memq 'space-after-tab::space whitespace-active-style)
;; Show SPACEs after TAB (TABs).
(whitespace-space-after-tab-regexp 'space)))
- 1 whitespace-space-after-tab t)))))
+ 1 whitespace-space-after-tab t)))
+ ,@(when (memq 'missing-newline-at-eof whitespace-active-style)
+ ;; Show missing newline.
+ `(("[^\n]\\'" 0
+ ;; Don't mark the end of the buffer is point is there --
+ ;; it probably means that the user is typing something
+ ;; at the end of the buffer.
+ (and (/= whitespace-point (point-max))
+ 'whitespace-missing-newline-at-eof)
+ t)))))
(font-lock-add-keywords nil whitespace-font-lock-keywords t)
(font-lock-flush)))
@@ -2177,6 +2178,19 @@ resultant list will be returned."
(setq status nil))) ;; end of buffer
status))
+(defun whitespace-lines-regexp (limit)
+ (re-search-forward
+ (let ((line-column (or whitespace-line-column fill-column)))
+ (format
+ "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
+ tab-width
+ (1- tab-width)
+ (/ line-column tab-width)
+ (let ((rem (% line-column tab-width)))
+ (if (zerop rem)
+ ""
+ (format ".\\{%d\\}" rem)))))
+ limit t))
(defun whitespace-empty-at-bob-regexp (limit)
"Match spaces at beginning of buffer which do not contain the point at \
@@ -2446,7 +2460,8 @@ It should be added buffer-locally to `write-file-functions'."
(provide 'whitespace)
-
+(make-obsolete-variable 'whitespace-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(run-hooks 'whitespace-load-hook)
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 097e769de8f..53f918cff9c 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -187,7 +187,7 @@ if that value is non-nil."
(define-widget 'widget-browse 'push-button
"Button for creating a widget browser.
-The :value of the widget shuld be the widget to be browsed."
+The :value of the widget should be the widget to be browsed."
:format "%[[%v]%]"
:value-create 'widget-browse-value-create
:action 'widget-browse-action)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 62846523be4..4e2cf7416d4 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -203,27 +203,100 @@ nil means read a single character."
:group 'widgets
:type 'boolean)
+(defun widget--simplify-menu (extended)
+ "Convert the EXTENDED menu into a menu composed of simple menu items.
+
+Each item in the simplified menu is of the form (ITEM-STRING . REAL-BINDING),
+where both elements are taken from the EXTENDED MENU. ITEM-STRING is the
+correspondent ITEM-NAME in the menu-item entry:
+ (menu-item ITEM-NAME REAL-BINDING . ITEM-PROPERTY-LIST), and REAL-BINDING is
+the symbol in the key vector, as in `define-key'.
+ (See `(elisp)Defining Menus' for more information.)
+
+Only visible, enabled and meaningful menu items make their way into
+the returned simplified menu. That is:
+For the menu item to be visible, it has to either lack a :visible form in its
+item-property-list, or the :visible form has to evaluate to a non-nil value.
+For the menu item to be enabled, it has to either lack a :enabled form in its
+item-property-list, or the :enable form has to evaluate to a non-nil value.
+Additionally, if the menu item is a radio button, then its selected form has
+to evaluate to nil for the menu item to be meaningful."
+ (let (simplified)
+ (map-keymap (lambda (ev def)
+ (when (and (eq (nth 0 def) 'menu-item)
+ (nth 2 def)) ; Only menu-items with a real binding.
+ ;; Loop through the item-property-list, looking for
+ ;; :visible, :enable (or :active) and :button properties.
+ (let ((plist (nthcdr 3 def))
+ (enable t) ; Enabled by default.
+ (visible t) ; Visible by default.
+ selected keyword value)
+ (while (and plist (cdr plist)
+ (keywordp (setq keyword (car plist))))
+ (setq value (cadr plist))
+ (cond ((memq keyword '(:visible :included))
+ (setq visible value))
+ ((memq keyword '(:enable :active))
+ (setq enable value))
+ ((and (eq keyword :button)
+ (eq (car value) :radio))
+ (setq selected (cdr value))))
+ (setq plist (cddr plist)))
+ (when (and (eval visible)
+ (eval enable)
+ (or (not selected)
+ (not (eval selected))))
+ (push (cons (nth 1 def) ev) simplified)))))
+ extended)
+ (reverse simplified)))
+
(defun widget-choose (title items &optional event)
"Choose an item from a list.
First argument TITLE is the name of the list.
-Second argument ITEMS is a list whose members are either
+Second argument ITEMS should be a menu, either with simple item definitions,
+or with extended item definitions.
+When ITEMS has simple item definitions, it is a list whose members are either
(NAME . VALUE), to indicate selectable items, or just strings to
indicate unselectable items.
+
+When ITEMS is a menu that uses an extended format, then ITEMS should be a
+keymap, and each binding should look like this:
+ (menu-item ITEM-NAME REAL-BINDING . ITEM-PROPERTY-LIST)
+or like this: (menu-item ITEM-NAME) to indicate a non-selectable item.
+REAL-BINDING should be a symbol, and should not be a keymap, because submenus
+are not supported.
+
Optional third argument EVENT is an input event.
-The user is asked to choose between each NAME from the items alist,
-and the VALUE of the chosen element will be returned. If EVENT is a
-mouse event, and the number of elements in items is less than
+If EVENT is a mouse event, and the number of elements in items is less than
`widget-menu-max-size', a popup menu will be used, otherwise the
-minibuffer."
+minibuffer.
+
+The user is asked to choose between each NAME from ITEMS.
+If ITEMS has simple item definitions, then this function returns the VALUE of
+the chosen element. If ITEMS is a keymap, then the return value is the symbol
+in the key vector, as in the argument of `define-key'."
(cond ((and (< (length items) widget-menu-max-size)
event (display-popup-menus-p))
;; Mouse click.
- (x-popup-menu event
- (list title (cons "" items))))
+ (if (keymapp items)
+ ;; Modify the keymap prompt, and then restore the old one, if any.
+ (let ((prompt (keymap-prompt items)))
+ (unwind-protect
+ (progn
+ (setq items (delete prompt items))
+ (push title (cdr items))
+ ;; Return just the first element of the list of events.
+ (car (x-popup-menu event items)))
+ (setq items (delete title items))
+ (when prompt
+ (push prompt (cdr items)))))
+ (x-popup-menu event (list title (cons "" items)))))
((or widget-menu-minibuffer-flag
(> (length items) widget-menu-max-shortcuts))
+ (when (keymapp items)
+ (setq items (widget--simplify-menu items)))
;; Read the choice of name from the minibuffer.
(setq items (cl-remove-if 'stringp items))
(let ((val (completing-read (concat title ": ") items nil t)))
@@ -233,11 +306,12 @@ minibuffer."
(setq val try))
(cdr (assoc val items))))))
(t
+ (when (keymapp items)
+ (setq items (widget--simplify-menu items)))
;; Construct a menu of the choices
;; and then use it for prompting for a single character.
(let* ((next-digit ?0)
- (map (make-sparse-keymap))
- choice some-choice-enabled value)
+ alist choice some-choice-enabled value)
(with-current-buffer (get-buffer-create " widget-choose")
(erase-buffer)
(insert "Available choices:\n\n")
@@ -247,7 +321,7 @@ minibuffer."
(let* ((name (substitute-command-keys (car choice)))
(function (cdr choice)))
(insert (format "%c = %s\n" next-digit name))
- (define-key map (vector next-digit) function)
+ (push (cons next-digit function) alist)
(setq some-choice-enabled t)))
;; Allocate digits to disabled alternatives
;; so that the digit of a given alternative never varies.
@@ -257,33 +331,17 @@ minibuffer."
(forward-line))
(or some-choice-enabled
(error "None of the choices is currently meaningful"))
- (define-key map [?\M-\C-v] 'scroll-other-window)
- (define-key map [?\M--] 'negative-argument)
(save-window-excursion
- (let ((buf (get-buffer " widget-choose")))
- (display-buffer buf
- '(display-buffer-in-direction
- (direction . bottom)
- (window-height . fit-window-to-buffer)))
- (let ((cursor-in-echo-area t)
- (arg 1))
- (while (not value)
- (setq value (lookup-key map (read-key-sequence (format "%s: " title))))
- (unless value
- (user-error "Canceled"))
- (when
- (cond ((eq value 'scroll-other-window)
- (let ((minibuffer-scroll-window
- (get-buffer-window buf)))
- (if (> 0 arg)
- (scroll-other-window-down
- (window-height minibuffer-scroll-window))
- (scroll-other-window))
- (setq arg 1)))
- ((eq value 'negative-argument)
- (setq arg -1)))
- (setq value nil))))))
- value))))
+ ;; Select window to be able to scroll it from minibuffer
+ (with-selected-window
+ (display-buffer (get-buffer " widget-choose")
+ '(display-buffer-in-direction
+ (direction . bottom)
+ (window-height . fit-window-to-buffer)))
+ (setq value (read-char-from-minibuffer
+ (format "%s: " title)
+ (mapcar #'car alist)))))
+ (cdr (assoc value alist))))))
;;; Widget text specifications.
;;
@@ -320,12 +378,15 @@ the :notify function can't know the new value.")
(or (not widget-field-add-space) (widget-get widget :size))))
(if (functionp help-echo)
(setq help-echo 'widget-mouse-help))
- (when (= (char-before to) ?\n)
+ (when (and (or (> to (1+ from)) (null (widget-get widget :size)))
+ (= (char-before to) ?\n))
;; When the last character in the field is a newline, we want to
;; give it a `field' char-property of `boundary', which helps the
;; C-n/C-p act more naturally when entering/leaving the field. We
- ;; do this by making a small secondary overlay to contain just that
- ;; one character.
+ ;; do this by making a small secondary overlay to contain just that
+ ;; one character. BUT we only do this if there is more than one
+ ;; character (so we don't do this for the character widget),
+ ;; or if the size of the editable field isn't specified.
(let ((overlay (make-overlay (1- to) to nil t nil)))
(overlay-put overlay 'field 'boundary)
;; We need the real field for tabbing.
@@ -594,6 +655,63 @@ respectively."
(if (and widget (funcall function widget maparg))
(setq overlays nil)))))
+(defun widget-describe (&optional widget-or-pos)
+ "Describe the widget at point.
+Displays a buffer with information about the widget (e.g., its actions) as well
+as a link to browse all the properties of the widget.
+
+This command resolves the indirection of widgets running the action of its
+parents, so the real action executed can be known.
+
+When called from Lisp, pass WIDGET-OR-POS as the widget to describe,
+or a buffer position where a widget is present. If WIDGET-OR-POS is nil,
+the widget at point is the widget to describe."
+ (interactive "d")
+ (require 'wid-browse) ; The widget-browse widget.
+ (let ((widget (if (widgetp widget-or-pos)
+ widget-or-pos
+ (widget-at widget-or-pos)))
+ props)
+ (when widget
+ (help-setup-xref (list #'widget-describe widget)
+ (called-interactively-p 'interactive))
+ (setq props (list (cons 'action (widget--resolve-parent-action widget))
+ (cons 'mouse-down-action
+ (widget-get widget :mouse-down-action))))
+ (with-help-window (help-buffer)
+ (with-current-buffer (help-buffer)
+ (widget-insert "This widget's type is ")
+ (widget-create 'widget-browse :format "%[%v%]\n%d"
+ :doc (get (car widget) 'widget-documentation)
+ :help-echo "Browse this widget's properties"
+ widget)
+ (dolist (action '(action mouse-down-action))
+ (let ((name (symbol-name action))
+ (val (alist-get action props)))
+ (when (functionp val)
+ (widget-insert "\n\n" (propertize (capitalize name) 'face 'bold)
+ "'\nThe " name " of this widget is")
+ (if (symbolp val)
+ (progn (widget-insert " ")
+ (widget-create 'function-link :value val
+ :button-prefix "" :button-suffix ""
+ :help-echo "Describe this function"))
+ (widget-insert "\n")
+ (princ val)))))))
+ (widget-setup)
+ t)))
+
+(defun widget--resolve-parent-action (widget)
+ "Resolve the real action of WIDGET up its inheritance chain.
+Follow the WIDGET's parents, until its :action is no longer
+`widget-parent-action', and return its value."
+ (let ((action (widget-get widget :action))
+ (parent (widget-get widget :parent)))
+ (while (eq action 'widget-parent-action)
+ (setq parent (widget-get parent :parent)
+ action (widget-get parent :action)))
+ action))
+
;;; Images.
(defcustom widget-image-directory (file-name-as-directory
@@ -933,86 +1051,91 @@ Note that such modes will need to require wid-edit.")
"If non-nil, `widget-button-click' moves point to a button after invoking it.
If nil, point returns to its original position after invoking a button.")
+(defun widget-button--check-and-call-button (event button)
+ "Call BUTTON if BUTTON is a widget and EVENT is correct for it.
+If nothing was called, return non-nil."
+ (let* ((oevent event)
+ (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
+ (pos (widget-event-point event))
+ newpoint)
+ (catch 'button-press-cancelled
+ ;; Mouse click on a widget button. Do the following
+ ;; in a save-excursion so that the click on the button
+ ;; doesn't change point.
+ (save-selected-window
+ (select-window (posn-window (event-start event)))
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (let* ((overlay (widget-get button :button-overlay))
+ (pressed-face (or (widget-get button :pressed-face)
+ widget-button-pressed-face))
+ (face (overlay-get overlay 'face))
+ (mouse-face (overlay-get overlay 'mouse-face)))
+ (unwind-protect
+ ;; Read events, including mouse-movement
+ ;; events, waiting for a release event. If we
+ ;; began with a mouse-1 event and receive a
+ ;; movement event, that means the user wants
+ ;; to perform drag-selection, so cancel the
+ ;; button press and do the default mouse-1
+ ;; action. For mouse-2, just highlight/
+ ;; unhighlight the button the mouse was
+ ;; initially on when we move over it.
+ (save-excursion
+ (when face ; avoid changing around image
+ (overlay-put overlay 'face pressed-face)
+ (overlay-put overlay 'mouse-face pressed-face))
+ (unless (widget-apply button :mouse-down-action event)
+ (let ((track-mouse t))
+ (while (not (widget-button-release-event-p event))
+ (setq event (read-event))
+ (when (and mouse-1 (mouse-movement-p event))
+ (push event unread-command-events)
+ (setq event oevent)
+ (throw 'button-press-cancelled t))
+ (unless (or (integerp event)
+ (memq (car event)
+ '(switch-frame select-window))
+ (eq (car event) 'scroll-bar-movement))
+ (setq pos (widget-event-point event))
+ (if (and pos
+ (eq (get-char-property pos 'button)
+ button))
+ (when face
+ (overlay-put overlay 'face pressed-face)
+ (overlay-put overlay 'mouse-face pressed-face))
+ (overlay-put overlay 'face face)
+ (overlay-put overlay 'mouse-face mouse-face))))))
+
+ ;; When mouse is released over the button, run
+ ;; its action function.
+ (when (and pos (eq (get-char-property pos 'button) button))
+ (goto-char pos)
+ (widget-apply-action button event)
+ (if widget-button-click-moves-point
+ (setq newpoint (point)))))
+ (overlay-put overlay 'face face)
+ (overlay-put overlay 'mouse-face mouse-face))))
+
+ (when newpoint
+ (goto-char newpoint)))
+ nil)))
+
(defun widget-button-click (event)
"Invoke the button that the mouse is pointing at."
(interactive "e")
(if (widget-event-point event)
- (let* ((oevent event)
- (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
+ (let* ((mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
(pos (widget-event-point event))
(start (event-start event))
- (button (get-char-property
+ (button (get-char-property
pos 'button (and (windowp (posn-window start))
- (window-buffer (posn-window start)))))
- newpoint)
+ (window-buffer (posn-window start))))))
+
(when (or (null button)
- (catch 'button-press-cancelled
- ;; Mouse click on a widget button. Do the following
- ;; in a save-excursion so that the click on the button
- ;; doesn't change point.
- (save-selected-window
- (select-window (posn-window (event-start event)))
- (save-excursion
- (goto-char (posn-point (event-start event)))
- (let* ((overlay (widget-get button :button-overlay))
- (pressed-face (or (widget-get button :pressed-face)
- widget-button-pressed-face))
- (face (overlay-get overlay 'face))
- (mouse-face (overlay-get overlay 'mouse-face)))
- (unwind-protect
- ;; Read events, including mouse-movement
- ;; events, waiting for a release event. If we
- ;; began with a mouse-1 event and receive a
- ;; movement event, that means the user wants
- ;; to perform drag-selection, so cancel the
- ;; button press and do the default mouse-1
- ;; action. For mouse-2, just highlight/
- ;; unhighlight the button the mouse was
- ;; initially on when we move over it.
- (save-excursion
- (when face ; avoid changing around image
- (overlay-put overlay 'face pressed-face)
- (overlay-put overlay 'mouse-face pressed-face))
- (unless (widget-apply button :mouse-down-action event)
- (let ((track-mouse t))
- (while (not (widget-button-release-event-p event))
- (setq event (read-event))
- (when (and mouse-1 (mouse-movement-p event))
- (push event unread-command-events)
- (setq event oevent)
- (throw 'button-press-cancelled t))
- (unless (or (integerp event)
- (memq (car event) '(switch-frame select-window))
- (eq (car event) 'scroll-bar-movement))
- (setq pos (widget-event-point event))
- (if (and pos
- (eq (get-char-property pos 'button)
- button))
- (when face
- (overlay-put overlay 'face pressed-face)
- (overlay-put overlay 'mouse-face pressed-face))
- (overlay-put overlay 'face face)
- (overlay-put overlay 'mouse-face mouse-face))))))
-
- ;; When mouse is released over the button, run
- ;; its action function.
- (when (and pos (eq (get-char-property pos 'button) button))
- (goto-char pos)
- (widget-apply-action button event)
- (if widget-button-click-moves-point
- (setq newpoint (point)))))
- (overlay-put overlay 'face face)
- (overlay-put overlay 'mouse-face mouse-face))))
-
- (if newpoint (goto-char newpoint))
- ;; This loses if the widget action switches windows. -- cyd
- ;; (unless (pos-visible-in-window-p (widget-event-point event))
- ;; (mouse-set-point event)
- ;; (beginning-of-line)
- ;; (recenter))
- )
- nil))
- (let ((up t) command)
+ (widget-button--check-and-call-button event button))
+ (let ((up t)
+ command)
;; Mouse click not on a widget button. Find the global
;; command to run, and check whether it is bound to an
;; up event.
@@ -1321,7 +1444,8 @@ Unlike (get-char-property POS \\='field), this works with empty fields too."
(signal 'text-read-only
'("Attempt to change text outside editable field")))
(widget-field-use-before-change
- (widget-apply from-field :notify from-field))))))
+ (widget-apply from-field :notify
+ from-field (list 'before-change from to)))))))
(defun widget-add-change ()
(remove-hook 'post-command-hook 'widget-add-change t)
@@ -1358,7 +1482,7 @@ Unlike (get-char-property POS \\='field), this works with empty fields too."
(> (point) begin))
(delete-char -1)))))))
(widget-specify-secret field))
- (widget-apply field :notify field))))
+ (widget-apply field :notify field (list 'after-change from to)))))
;;; Widget Functions
;;
@@ -1871,6 +1995,16 @@ If END is omitted, it defaults to the length of LIST."
"Show the variable specified by WIDGET."
(describe-variable (widget-value widget)))
+;;; The `face-link' Widget.
+
+(define-widget 'face-link 'link
+ "A link to an Emacs face."
+ :action 'widget-face-link-action)
+
+(defun widget-face-link-action (widget &optional _event)
+ "Show the variable specified by WIDGET."
+ (describe-face (widget-value widget)))
+
;;; The `file-link' Widget.
(define-widget 'file-link 'link
@@ -2587,7 +2721,10 @@ Return an alist of (TYPE MATCH)."
(define-widget 'insert-button 'push-button
"An insert button for the `editable-list' widget."
:tag "INS"
- :help-echo "Insert a new item into the list at this position."
+ :help-echo (lambda (widget)
+ (if (widget-get (widget-get widget :parent) :last-deleted)
+ "Insert back the last deleted item from this list, at this position."
+ "Insert a new item into the list at this position."))
:action 'widget-insert-button-action)
(defun widget-insert-button-action (widget &optional _event)
@@ -2600,7 +2737,7 @@ Return an alist of (TYPE MATCH)."
(define-widget 'delete-button 'push-button
"A delete button for the `editable-list' widget."
:tag "DEL"
- :help-echo "Delete this item from the list."
+ :help-echo "Delete this item from the list, saving it for later reinsertion."
:action 'widget-delete-button-action)
(defun widget-delete-button-action (widget &optional _event)
@@ -2690,9 +2827,18 @@ Return an alist of (TYPE MATCH)."
(cons found value)))
(defun widget-editable-list-insert-before (widget before)
- ;; Insert a new child in the list of children.
+ "Insert a new widget as a child of WIDGET.
+
+If there is a recently deleted child, the new widget is that deleted child.
+Otherwise, the new widget is the default child of WIDGET.
+
+The new widget gets inserted at the position of the BEFORE child."
(save-excursion
(let ((children (widget-get widget :children))
+ (last-deleted (when-let ((lst (widget-get widget :last-deleted)))
+ (prog1
+ (pop lst)
+ (widget-put widget :last-deleted lst))))
(inhibit-read-only t)
(inhibit-modification-hooks t))
(cond (before
@@ -2700,7 +2846,11 @@ Return an alist of (TYPE MATCH)."
(t
(goto-char (widget-get widget :value-pos))))
(let ((child (widget-editable-list-entry-create
- widget nil nil)))
+ widget (and last-deleted
+ (widget-apply last-deleted
+ :value-to-external
+ (widget-get last-deleted :value)))
+ last-deleted)))
(when (< (widget-get child :entry-from) (widget-get widget :from))
(set-marker (widget-get widget :from)
(widget-get child :entry-from)))
@@ -2713,6 +2863,15 @@ Return an alist of (TYPE MATCH)."
(widget-apply widget :notify widget))
(defun widget-editable-list-delete-at (widget child)
+ "Delete the widget CHILD from the known children of widget WIDGET.
+
+Save CHILD into the :last-deleted list, so it can be inserted later."
+ ;; Save the current value of CHILD, to use if the user later inserts the
+ ;; widget.
+ (widget-put child :value (widget-apply child :value-get))
+ (let ((lst (widget-get widget :last-deleted)))
+ (push child lst)
+ (widget-put widget :last-deleted lst))
;; Delete child from list of children.
(save-excursion
(let ((buttons (copy-sequence (widget-get widget :buttons)))
@@ -3121,6 +3280,16 @@ It reads a file name from an editable text field."
:completions (completion-table-case-fold
#'completion-file-name-table
(not read-file-name-completion-ignore-case))
+ :match (lambda (widget value)
+ (and (stringp value)
+ (or (not (widget-get widget :must-match))
+ (file-exists-p value))))
+ :validate (lambda (widget)
+ (let ((value (widget-value widget)))
+ (unless (widget-apply widget :match value)
+ (widget-put widget
+ :error (format "File %s does not exist" value))
+ widget)))
:prompt-value 'widget-file-prompt-value
:format "%{%t%}: %v"
;; Doesn't work well with terminating newline.
@@ -3132,11 +3301,10 @@ It reads a file name from an editable text field."
(abbreviate-file-name
(if unbound
(read-file-name prompt)
- (let ((prompt2 (format "%s (default %s): " prompt value))
- (dir (file-name-directory value))
+ (let ((dir (file-name-directory value))
(file (file-name-nondirectory value))
(must-match (widget-get widget :must-match)))
- (read-file-name prompt2 dir nil must-match file)))))
+ (read-file-name (format-prompt prompt value) dir nil must-match file)))))
;;;(defun widget-file-action (widget &optional event)
;;; ;; Read a file name from the minibuffer.
@@ -3248,10 +3416,10 @@ It reads a directory name from an editable text field."
"Read coding-system from minibuffer."
(if (widget-get widget :base-only)
(intern
- (completing-read (format "%s (default %s): " prompt value)
+ (completing-read (format-prompt prompt value)
(mapcar #'list (coding-system-list t)) nil nil nil
coding-system-history))
- (read-coding-system (format "%s (default %s): " prompt value) value)))
+ (read-coding-system (format-prompt prompt value) value)))
(defun widget-coding-system-action (widget &optional event)
(let ((answer
@@ -3416,8 +3584,31 @@ To use this type, you must define :match or :match-alternatives."
:match 'widget-restricted-sexp-match
:value-to-internal (lambda (widget value)
(if (widget-apply widget :match value)
- (prin1-to-string value)
- value)))
+ (widget-sexp-value-to-internal widget value)
+ value))
+ :value-to-external (lambda (widget value)
+ ;; We expect VALUE to be a string, so we can convert it
+ ;; into the external format just by `read'ing it.
+ ;; But for a restricted-sexp widget with a bad default
+ ;; value, we might end up calling read with a nil
+ ;; argument, resulting in an undesired prompt to the
+ ;; user. A bad default value is not always a big
+ ;; problem, but might end up in a messed up buffer,
+ ;; so display a warning here. (Bug#25152)
+ (unless (stringp value)
+ (display-warning
+ 'widget-bad-default-value
+ (format-message
+ "\nA widget of type %S has a bad default value.
+value: %S
+match function: %S
+match-alternatives: %S"
+ (widget-type widget)
+ value
+ (widget-get widget :match)
+ (widget-get widget :match-alternatives))
+ :warning))
+ (read value)))
(defun widget-restricted-sexp-match (widget value)
(let ((alternatives (widget-get widget :match-alternatives))
@@ -3459,19 +3650,76 @@ To use this type, you must define :match or :match-alternatives."
:value 0
:size 1
:format "%{%t%}: %v\n"
- :valid-regexp "\\`.\\'"
+ :valid-regexp "\\`\\(.\\|\n\\)\\'"
:error "This field should contain a single character"
:value-get (lambda (w) (widget-field-value-get w t))
:value-to-internal (lambda (_widget value)
(if (stringp value)
value
- (char-to-string value)))
+ (let ((disp
+ (widget-character--change-character-display
+ value)))
+ (if disp
+ (propertize (char-to-string value) 'display disp)
+ (char-to-string value)))))
:value-to-external (lambda (_widget value)
(if (stringp value)
(aref value 0)
value))
:match (lambda (_widget value)
- (characterp value)))
+ (characterp value))
+ :notify #'widget-character-notify)
+
+;; Only some escape sequences, not all of them. (Bug#15925)
+(defvar widget-character--escape-sequences-alist
+ '((?\t . ?t)
+ (?\n . ?n)
+ (?\s . ?s))
+ "Alist that associates escape sequences to a character.
+Each element has the form (ESCAPE-SEQUENCE . CHARACTER).
+
+The character widget uses this alist to display the
+non-printable character represented by ESCAPE-SEQUENCE as \\CHARACTER,
+since that makes it easier to see what's in the widget.")
+
+(defun widget-character--change-character-display (c)
+ "Return a string to represent the character C, or nil.
+
+The character widget represents some characters (e.g., the newline character
+or the tab character) specially, to make it easier for the user to see what's
+in it. For those characters, return a string to display that character in a
+more user-friendly way.
+
+For the caller, nil should mean that it is good enough to use the return value
+of `char-to-string' for the representation of C."
+ (let ((char (alist-get c widget-character--escape-sequences-alist)))
+ (and char (propertize (format "\\%c" char) 'face 'escape-glyph))))
+
+(defun widget-character-notify (widget child &optional event)
+ "Notify function for the character widget.
+
+This function allows the widget character to better display some characters,
+like the newline character or the tab character."
+ (when (eq (car-safe event) 'after-change)
+ (let* ((start (nth 1 event))
+ (end (nth 2 event))
+ str)
+ (if (eql start end)
+ (when (char-equal (widget-value widget) ?\s)
+ ;; The character widget is not really empty:
+ ;; its value is a single space character.
+ ;; We need to propertize it again, if it became empty for a while.
+ (let ((ov (widget-get widget :field-overlay)))
+ (put-text-property
+ (overlay-start ov) (overlay-end ov)
+ 'display (widget-character--change-character-display ?\s))))
+ (setq str (buffer-substring-no-properties start end))
+ ;; This assumes the user enters one character at a time,
+ ;; and does nothing crazy, like yanking a long string.
+ (let ((disp (widget-character--change-character-display (aref str 0))))
+ (when disp
+ (put-text-property start end 'display disp))))))
+ (widget-default-notify widget child event))
(define-widget 'list 'group
"A Lisp list."
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 6e62e161548..65579600640 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -461,50 +461,38 @@ select the window with a displayed buffer, and the meaning of
the prefix argument is reversed.
When `switch-to-buffer-obey-display-actions' is non-nil,
`switch-to-buffer' commands are also supported."
- (let* ((no-select (xor (consp arg) windmove-display-no-select))
- (old-window (or (minibuffer-selected-window) (selected-window)))
- (new-window)
- (minibuffer-depth (minibuffer-depth))
- (action (lambda (buffer alist)
- (unless (> (minibuffer-depth) minibuffer-depth)
- (let ((window (cond
- ((eq dir 'new-tab)
- (let ((tab-bar-new-tab-choice t))
- (tab-bar-new-tab))
- (selected-window))
- ((eq dir 'same-window)
- (selected-window))
- (t (window-in-direction
- dir nil nil
- (and arg (prefix-numeric-value arg))
- windmove-wrap-around))))
- (type 'reuse))
- (unless window
- (setq window (split-window nil nil dir) type 'window))
- (setq new-window (window--display-buffer buffer window
- type alist))))))
- (command this-command)
- (clearfun (make-symbol "clear-display-buffer-overriding-action"))
- (exitfun
- (lambda ()
- (setq display-buffer-overriding-action
- (delq action display-buffer-overriding-action))
- (when (window-live-p (if no-select old-window new-window))
- (select-window (if no-select old-window new-window)))
- (remove-hook 'post-command-hook clearfun))))
- (fset clearfun
- (lambda ()
- (unless (or
- ;; Remove the hook immediately
- ;; after exiting the minibuffer.
- (> (minibuffer-depth) minibuffer-depth)
- ;; But don't remove immediately after
- ;; adding the hook by the same command below.
- (eq this-command command))
- (funcall exitfun))))
- (add-hook 'post-command-hook clearfun)
- (push action display-buffer-overriding-action)
- (message "[display-%s]" dir)))
+ (let ((no-select (xor (consp arg) windmove-display-no-select)))
+ (display-buffer-override-next-command
+ (lambda (_buffer alist)
+ (let* ((type 'reuse)
+ (window (cond
+ ((eq dir 'new-tab)
+ (let ((tab-bar-new-tab-choice t))
+ (tab-bar-new-tab))
+ (setq type 'tab)
+ (selected-window))
+ ((eq dir 'new-frame)
+ (let* ((params (cdr (assq 'pop-up-frame-parameters alist)))
+ (pop-up-frame-alist (append params pop-up-frame-alist))
+ (frame (make-frame-on-current-monitor
+ pop-up-frame-alist)))
+ (unless (cdr (assq 'inhibit-switch-frame alist))
+ (window--maybe-raise-frame frame))
+ (setq type 'frame)
+ (frame-selected-window frame)))
+ ((eq dir 'same-window)
+ (selected-window))
+ (t (window-in-direction
+ dir nil nil
+ (and arg (prefix-numeric-value arg))
+ windmove-wrap-around)))))
+ (unless window
+ (setq window (split-window nil nil dir) type 'window))
+ (cons window type)))
+ (lambda (old-window new-window)
+ (when (window-live-p (if no-select old-window new-window))
+ (select-window (if no-select old-window new-window))))
+ (format "[display-%s]" dir))))
;;;###autoload
(defun windmove-display-left (&optional arg)
@@ -541,6 +529,12 @@ See the logic of the prefix ARG in `windmove-display-in-direction'."
(windmove-display-in-direction 'same-window arg))
;;;###autoload
+(defun windmove-display-new-frame (&optional arg)
+ "Display the next buffer in a new frame."
+ (interactive "P")
+ (windmove-display-in-direction 'new-frame arg))
+
+;;;###autoload
(defun windmove-display-new-tab (&optional arg)
"Display the next buffer in a new tab."
(interactive "P")
@@ -561,6 +555,7 @@ Default value of MODIFIERS is `shift-meta'."
(global-set-key (vector (append modifiers '(up))) 'windmove-display-up)
(global-set-key (vector (append modifiers '(down))) 'windmove-display-down)
(global-set-key (vector (append modifiers '(?0))) 'windmove-display-same-window)
+ (global-set-key (vector (append modifiers '(?f))) 'windmove-display-new-frame)
(global-set-key (vector (append modifiers '(?t))) 'windmove-display-new-tab))
diff --git a/lisp/window.el b/lisp/window.el
index ba56dedf046..d564ec55468 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -226,7 +226,9 @@ BODY."
"Show a buffer BUFFER-OR-NAME and evaluate BODY in that buffer.
This construct is like `with-current-buffer-window' but unlike that,
displays the buffer specified by BUFFER-OR-NAME before running BODY."
- (declare (debug t) (indent 3))
+ (declare (debug t) (indent 3)
+ (obsolete "use `with-current-buffer-window' with action alist entry `body-function'."
+ "28.1"))
(let ((buffer (make-symbol "buffer"))
(window (make-symbol "window"))
(value (make-symbol "value")))
@@ -278,6 +280,24 @@ displays the buffer specified by BUFFER-OR-NAME before running BODY."
(funcall ,vquit-function ,window ,value)
,value)))))
+(defmacro with-window-non-dedicated (window &rest body)
+ "Evaluate BODY with WINDOW temporarily made non-dedicated.
+If WINDOW is nil, use the selected window. Return the value of
+the last form in BODY."
+ (declare (indent 1) (debug t))
+ (let ((window-dedicated-sym (gensym))
+ (window-sym (gensym)))
+ `(let* ((,window-sym (window-normalize-window ,window t))
+ (,window-dedicated-sym (window-dedicated-p ,window-sym)))
+ (set-window-dedicated-p ,window-sym nil)
+ (unwind-protect
+ (progn ,@body)
+ ;; `window-dedicated-p' returns the value set by
+ ;; `set-window-dedicated-p', which differentiates non-nil and
+ ;; t, so we cannot simply use t here. That's why we use
+ ;; `window-dedicated-sym'.
+ (set-window-dedicated-p ,window-sym ,window-dedicated-sym)))))
+
;; The following two functions are like `window-next-sibling' and
;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so
;; they don't substitute the selected window for nil), and they return
@@ -2152,7 +2172,8 @@ the font."
(with-selected-window (window-normalize-window window t)
(let* ((window-width (window-body-width window t))
(font-width (window-font-width window face))
- (ncols (/ window-width font-width)))
+ (ncols (- (/ window-width font-width)
+ (ceiling (line-number-display-width 'columns)))))
(if (and (display-graphic-p)
overflow-newline-into-fringe
(not
@@ -2622,12 +2643,17 @@ and no others."
"Return t if WINDOW is the currently active minibuffer window."
(and (window-live-p window) (eq window (active-minibuffer-window))))
-(defun count-windows (&optional minibuf)
+(defun count-windows (&optional minibuf all-frames)
"Return the number of live windows on the selected frame.
+
The optional argument MINIBUF specifies whether the minibuffer
-window shall be counted. See `walk-windows' for the precise
-meaning of this argument."
- (length (window-list-1 nil minibuf)))
+window is included in the count.
+
+If ALL-FRAMES is non-nil, count the windows in all frames instead
+just the selected frame.
+
+See `walk-windows' for the precise meaning of this argument."
+ (length (window-list-1 nil minibuf all-frames)))
;;; Resizing windows.
(defun window--size-to-pixel (window size &optional horizontal pixelwise round-maybe)
@@ -3911,7 +3937,7 @@ TOP RIGHT BOTTOM) as returned by `window-edges'."
(setq frame (window-normalize-frame frame))
(window--subtree (frame-root-window frame) t))
-(defun other-window (count &optional all-frames)
+(defun other-window (count &optional all-frames interactive)
"Select another window in cyclic ordering of windows.
COUNT specifies the number of windows to skip, starting with the
selected window, before making the selection. If COUNT is
@@ -3931,7 +3957,7 @@ This function uses `next-window' for finding the window to
select. The argument ALL-FRAMES has the same meaning as in
`next-window', but the MINIBUF argument of `next-window' is
always effectively nil."
- (interactive "p")
+ (interactive "p\ni\np")
(let* ((window (selected-window))
(original-window window)
(function (and (not ignore-window-parameters)
@@ -3977,13 +4003,53 @@ always effectively nil."
(setq count (1+ count)))))
(when (and (eq window original-window)
- (called-interactively-p 'interactive))
+ interactive
+ (not (or executing-kbd-macro noninteractive)))
(message "No other window to select"))
(select-window window)
;; Always return nil.
nil))))
+(defun other-window-prefix ()
+ "Display the buffer of the next command in a new window.
+The next buffer is the buffer displayed by the next command invoked
+immediately after this command (ignoring reading from the minibuffer).
+Creates a new window before displaying the buffer.
+When `switch-to-buffer-obey-display-actions' is non-nil,
+`switch-to-buffer' commands are also supported."
+ (interactive)
+ (display-buffer-override-next-command
+ (lambda (buffer alist)
+ (let ((alist (append '((inhibit-same-window . t)) alist))
+ window type)
+ (if (setq window (display-buffer-pop-up-window buffer alist))
+ (setq type 'window)
+ (setq window (display-buffer-use-some-window buffer alist)
+ type 'reuse))
+ (cons window type)))
+ nil "[other-window]")
+ (message "Display next command buffer in a new window..."))
+
+(defun same-window-prefix ()
+ "Display the buffer of the next command in the same window.
+The next buffer is the buffer displayed by the next command invoked
+immediately after this command (ignoring reading from the minibuffer).
+Even when the default rule should display the buffer in a new window,
+force its display in the already selected window.
+When `switch-to-buffer-obey-display-actions' is non-nil,
+`switch-to-buffer' commands are also supported."
+ (interactive)
+ (display-buffer-override-next-command
+ (lambda (buffer alist)
+ (setq alist (append '((inhibit-same-window . nil)) alist))
+ (cons (or
+ (display-buffer-same-window buffer alist)
+ (display-buffer-use-some-window buffer alist))
+ 'reuse))
+ nil "[same-window]")
+ (message "Display next command buffer in the same window..."))
+
;; This should probably return non-nil when the selected window is part
;; of an atomic window whose root is the frame's root window.
(defun one-window-p (&optional nomini all-frames)
@@ -4192,7 +4258,7 @@ that is its frame's root window."
;; Always return nil.
nil))))
-(defun delete-other-windows (&optional window)
+(defun delete-other-windows (&optional window interactive)
"Make WINDOW fill its frame.
WINDOW must be a valid window and defaults to the selected one.
Return nil.
@@ -4209,7 +4275,7 @@ with the root of the atomic window as its argument. Signal an
error if that root window is the root window of WINDOW's frame.
Also signal an error if WINDOW is a side window. Do not delete
any window whose `no-delete-other-windows' parameter is non-nil."
- (interactive)
+ (interactive "i\np")
(setq window (window-normalize-window window))
(let* ((frame (window-frame window))
(function (window-parameter window 'delete-other-windows))
@@ -4275,7 +4341,8 @@ any window whose `no-delete-other-windows' parameter is non-nil."
(if (eq window main)
;; Give a message to the user if this has been called as a
;; command.
- (when (called-interactively-p 'interactive)
+ (when (and interactive
+ (not (or executing-kbd-macro noninteractive)))
(message "No other windows to delete"))
(delete-other-windows-internal window main)
(window--check frame))
@@ -4838,11 +4905,11 @@ displayed there."
(interactive)
(switch-to-buffer (last-buffer)))
-(defun next-buffer (&optional arg)
+(defun next-buffer (&optional arg interactive)
"In selected window switch to ARGth next buffer.
Call `switch-to-next-buffer' unless the selected window is the
minibuffer window or is dedicated to its buffer."
- (interactive "p")
+ (interactive "p\np")
(cond
((window-minibuffer-p)
(user-error "Cannot switch buffers in minibuffer window"))
@@ -4851,14 +4918,15 @@ minibuffer window or is dedicated to its buffer."
(t
(dotimes (_ (or arg 1))
(when (and (not (switch-to-next-buffer))
- (called-interactively-p 'interactive))
+ interactive
+ (not (or executing-kbd-macro noninteractive)))
(user-error "No next buffer"))))))
-(defun previous-buffer (&optional arg)
+(defun previous-buffer (&optional arg interactive)
"In selected window switch to ARGth previous buffer.
Call `switch-to-prev-buffer' unless the selected window is the
minibuffer window or is dedicated to its buffer."
- (interactive "p")
+ (interactive "p\np")
(cond
((window-minibuffer-p)
(user-error "Cannot switch buffers in minibuffer window"))
@@ -4867,7 +4935,8 @@ minibuffer window or is dedicated to its buffer."
(t
(dotimes (_ (or arg 1))
(when (and (not (switch-to-prev-buffer))
- (called-interactively-p 'interactive))
+ interactive
+ (not (or executing-kbd-macro noninteractive)))
(user-error "No previous buffer"))))))
(defun delete-windows-on (&optional buffer-or-name frame)
@@ -5009,6 +5078,13 @@ nil means to not handle the buffer in a particular way. This
quad entry)
(cond
((and (not prev-buffer)
+ (eq (nth 1 quit-restore) 'tab)
+ (eq (nth 3 quit-restore) buffer))
+ (tab-bar-close-tab)
+ ;; If the previously selected window is still alive, select it.
+ (when (window-live-p (nth 2 quit-restore))
+ (select-window (nth 2 quit-restore))))
+ ((and (not prev-buffer)
(or (eq (nth 1 quit-restore) 'frame)
(and (eq (nth 1 quit-restore) 'window)
;; If the window has been created on an existing
@@ -5665,10 +5741,10 @@ window."
WINDOW defaults to the selected window. DIRECTION can be
nil (i.e. any), `height' or `width'."
(with-current-buffer (window-buffer window)
- (when (and (boundp 'window-size-fixed) window-size-fixed)
- (not (and direction
- (member (cons direction window-size-fixed)
- '((height . width) (width . height))))))))
+ (and window-size-fixed
+ (not (and direction
+ (member (cons direction window-size-fixed)
+ '((height . width) (width . height))))))))
;;; A different solution to balance-windows.
(defvar window-area-factor 1
@@ -6373,7 +6449,12 @@ fourth element is BUFFER."
;; WINDOW has been created on a new frame.
(set-window-parameter
window 'quit-restore
- (list 'frame 'frame (selected-window) buffer)))))
+ (list 'frame 'frame (selected-window) buffer)))
+ ((eq type 'tab)
+ ;; WINDOW has been created on a new tab.
+ (set-window-parameter
+ window 'quit-restore
+ (list 'tab 'tab (selected-window) buffer)))))
(defcustom display-buffer-function nil
"If non-nil, function to call to handle `display-buffer'.
@@ -7040,8 +7121,14 @@ Return WINDOW if BUFFER and WINDOW are live."
;; use that.
(display-buffer-mark-dedicated
(set-window-dedicated-p window display-buffer-mark-dedicated))))
- (when (memq type '(window frame))
+ (when (memq type '(window frame tab))
(set-window-prev-buffers window nil))
+
+ (when (functionp (cdr (assq 'body-function alist)))
+ (let ((inhibit-read-only t)
+ (inhibit-modification-hooks t))
+ (funcall (cdr (assq 'body-function alist)) window)))
+
(let ((quit-restore (window-parameter window 'quit-restore))
(height (cdr (assq 'window-height alist)))
(width (cdr (assq 'window-width alist)))
@@ -7369,6 +7456,12 @@ Action alist entries are:
parameters to give the chosen window.
`allow-no-window' -- A non-nil value means that `display-buffer'
may not display the buffer and return nil immediately.
+ `body-function' -- A function called with one argument - the
+ displayed window. It is called after the buffer is
+ displayed, and before `window-height', `window-width'
+ and `preserve-size' are applied. The function is supposed
+ to fill the window body with some contents that might depend
+ on dimensions of the displayed window.
The entries `window-height', `window-width' and `preserve-size'
are applied only when the window used for displaying the buffer
@@ -7625,7 +7718,7 @@ indirectly called by the latter."
(with-current-buffer (window-buffer window)
(cond ((memq major-mode allowed-modes)
'same)
- ((derived-mode-p allowed-modes)
+ ((apply #'derived-mode-p allowed-modes)
'derived)))))
(when (and mode?
(not (and inhibit-same-window-p
@@ -7885,15 +7978,15 @@ Info node `(elisp) Buffer Display Action Alists' for details of
such alists.
ALIST has to contain a `direction' entry whose value should be
-one of `left', `above' (or `up'), `right' and `below' (or
-'down'). Other values are usually interpreted as `below'.
+one of `left', `above' (or `up'), `right' and `below' (or `down').
+Other values are usually interpreted as `below'.
If ALIST also contains a `window' entry, its value specifies a
reference window. That value can be a special symbol like
-'main' (which stands for the selected frame's main window) or
-'root' (standings for the selected frame's root window) or an
+`main' (which stands for the selected frame's main window) or
+`root' (standings for the selected frame's root window) or an
arbitrary valid window. Any other value (or omitting the
-'window' entry) means to use the selected window as reference
+`window' entry) means to use the selected window as reference
window.
This function tries to reuse or split a window such that the
@@ -8536,6 +8629,60 @@ documentation for additional customization information."
(interactive
(list (read-buffer-to-switch "Switch to buffer in other frame: ")))
(pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord))
+
+(defun display-buffer-override-next-command (pre-function &optional post-function echo)
+ "Set `display-buffer-overriding-action' for the next command.
+`pre-function' is called to prepare the window where the buffer should be
+displayed. This function takes two arguments `buffer' and `alist', and
+should return a cons with the displayed window and its type. See the
+meaning of these values in `window--display-buffer'.
+Optional `post-function' is called after the buffer is displayed in the
+window; the function takes two arguments: an old and new window.
+Optional string argument `echo' can be used to add a prefix to the
+command echo keystrokes that should describe the current prefix state."
+ (let* ((old-window (or (minibuffer-selected-window) (selected-window)))
+ (new-window nil)
+ (minibuffer-depth (minibuffer-depth))
+ (clearfun (make-symbol "clear-display-buffer-overriding-action"))
+ (action (lambda (buffer alist)
+ (unless (> (minibuffer-depth) minibuffer-depth)
+ (let* ((ret (funcall pre-function buffer alist))
+ (window (car ret))
+ (type (cdr ret)))
+ (setq new-window (window--display-buffer buffer window
+ type alist))
+ ;; Reset display-buffer-overriding-action
+ ;; after the first buffer display action
+ (funcall clearfun)
+ (setq post-function nil)
+ new-window))))
+ (command this-command)
+ (echofun (when echo (lambda () echo)))
+ (exitfun
+ (lambda ()
+ (setcar display-buffer-overriding-action
+ (delq action (car display-buffer-overriding-action)))
+ (remove-hook 'post-command-hook clearfun)
+ (remove-hook 'prefix-command-echo-keystrokes-functions echofun)
+ (when (functionp post-function)
+ (funcall post-function old-window new-window)))))
+ (fset clearfun
+ (lambda ()
+ (unless (or
+ ;; Remove the hook immediately
+ ;; after exiting the minibuffer.
+ (> (minibuffer-depth) minibuffer-depth)
+ ;; But don't remove immediately after
+ ;; adding the hook by the same command below.
+ (eq this-command command))
+ (funcall exitfun))))
+ ;; Reset display-buffer-overriding-action
+ ;; after the next command finishes
+ (add-hook 'post-command-hook clearfun)
+ (when echofun
+ (add-hook 'prefix-command-echo-keystrokes-functions echofun))
+ (push action (car display-buffer-overriding-action))))
+
(defun set-window-text-height (window height)
"Set the height in lines of the text display area of WINDOW to HEIGHT.
@@ -8596,16 +8743,32 @@ in some window."
(setq end (point-max)))
(if (= beg end)
0
- (save-excursion
- (save-restriction
- (widen)
- (narrow-to-region (min beg end)
- (if (and (not count-final-newline)
- (= ?\n (char-before (max beg end))))
- (1- (max beg end))
- (max beg end)))
- (goto-char (point-min))
- (1+ (vertical-motion (buffer-size) window))))))
+ (let ((start (min beg end))
+ (finish (max beg end))
+ count end-invisible-p)
+ ;; When END is invisible because lines are truncated in WINDOW,
+ ;; vertical-motion returns a number that is 1 larger than it
+ ;; should. We need to fix that.
+ (setq end-invisible-p
+ (and (or truncate-lines
+ (and (natnump truncate-partial-width-windows)
+ (< (window-total-width window)
+ truncate-partial-width-windows)))
+ (save-excursion
+ (goto-char finish)
+ (> (- (current-column) (window-hscroll window))
+ (window-body-width window)))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (narrow-to-region start
+ (if (and (not count-final-newline)
+ (= ?\n (char-before finish)))
+ (1- finish)
+ finish))
+ (goto-char start)
+ (setq count (vertical-motion (buffer-size) window))
+ (if end-invisible-p count (1+ count)))))))
(defun window-buffer-height (window)
"Return the height (in screen lines) of the buffer that WINDOW is displaying.
@@ -10043,5 +10206,9 @@ displaying that processes's buffer."
(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
(define-key ctl-x-map "+" 'balance-windows)
(define-key ctl-x-4-map "0" 'kill-buffer-and-window)
+(define-key ctl-x-4-map "1" 'same-window-prefix)
+(define-key ctl-x-4-map "4" 'other-window-prefix)
+
+(provide 'window)
;;; window.el ends here
diff --git a/lisp/woman.el b/lisp/woman.el
index 8465ab7c32e..96ae7fe5794 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -6,7 +6,7 @@
;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, unix
;; Adapted-By: Eli Zaretskii <eliz@gnu.org>
-;; Version: 0.551
+;; Old-Version: 0.551
;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/
;; This file is part of GNU Emacs.
@@ -401,6 +401,7 @@
;;; Code:
(defvar woman-version "0.551 (beta)" "WoMan version information.")
+(make-obsolete-variable 'woman-version nil "28.1")
(require 'man)
(require 'button)
@@ -674,7 +675,7 @@ These normally have names of the form `man?'. Its default value is
\"[Mm][Aa][Nn]\", which is case-insensitive mainly for the benefit of
Microsoft platforms. Its purpose is to avoid `cat?', `.', `..', etc."
;; Based on a suggestion by Wei-Xue Shi.
- :type 'string
+ :type 'regexp
:group 'woman-interface)
(defcustom woman-path
@@ -753,7 +754,7 @@ Default is t."
An alist with elements of the form (MENU-TITLE REGEXP INDEX) --
see the documentation for `imenu-generic-expression'."
:type '(alist :key-type (choice :tag "Title" (const nil) string)
- :value-type (group (choice (string :tag "Regexp")
+ :value-type (group (choice (regexp :tag "Regexp")
function)
integer))
:group 'woman-interface)
@@ -913,8 +914,8 @@ Troff emulation is experimental and largely untested.
:group 'faces)
(defcustom woman-fontify
- (or (and (fboundp 'display-color-p) (display-color-p))
- (and (fboundp 'display-graphic-p) (display-graphic-p))
+ (or (display-color-p)
+ (display-graphic-p)
(x-display-color-p))
"If non-nil then WoMan assumes that face support is available.
It defaults to a non-nil value if the display supports either colors
@@ -1276,14 +1277,11 @@ cache to be re-read."
(test-completion
word-at-point woman-topic-all-completions))
word-at-point)))
- (completing-read
- (if default
- (format "Manual entry (default %s): " default)
- "Manual entry: ")
- woman-topic-all-completions nil 1
- nil
- 'woman-topic-history
- default))))
+ (completing-read (format-prompt "Manual entry" default)
+ woman-topic-all-completions nil 1
+ nil
+ 'woman-topic-history
+ default))))
;; Note that completing-read always returns a string.
(unless (= (length topic) 0)
(cond
@@ -1830,7 +1828,6 @@ Argument EVENT is the invoking mouse event."
["Mini Help" woman-mini-help t]
,@(if (fboundp 'customize-group)
'(["Customize..." (customize-group 'woman) t]))
- ["Show Version" (message "WoMan %s" woman-version) t]
"--"
("Advanced"
["View Source" (view-file woman-last-file-name) woman-last-file-name]
@@ -1878,7 +1875,6 @@ Argument EVENT is the invoking mouse event."
WoMan is an ELisp emulation of much of the functionality of the Emacs
`man' command running the standard UN*X man and ?roff programs.
WoMan author: F.J.Wright@Maths.QMW.ac.uk
-WoMan version: see `woman-version'.
See `Man-mode' for additional details.
\\{woman-mode-map}"
(let ((Man-build-page-list (symbol-function 'Man-build-page-list))
@@ -2293,6 +2289,12 @@ Currently set only from \\='\\\" t in the first line of the source file.")
(setq fill-column woman-fill-column
tab-width woman-tab-width)
+ ;; Ignore the \, and \/ kerning operators. See
+ ;; https://www.gnu.org/software/groff/manual/groff.html#Ligatures-and-Kerning
+ (goto-char (point-min))
+ (while (re-search-forward "\\\\[,/]" nil t)
+ (replace-match "" t t))
+
;; Hide unpaddable and digit-width spaces \(space) and \0:
(goto-char from)
(while (re-search-forward "\\\\[ 0]" nil t)
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index ea9d119e2ff..1d49f462531 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -1,4 +1,4 @@
-;;; x-dnd.el --- drag and drop support for X
+;;; x-dnd.el --- drag and drop support for X -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2020 Free Software Foundation, Inc.
@@ -32,7 +32,7 @@
(require 'dnd)
;;; Customizable variables
-(defcustom x-dnd-test-function 'x-dnd-default-test-function
+(defcustom x-dnd-test-function #'x-dnd-default-test-function
"The function drag and drop uses to determine if to accept or reject a drop.
The function takes three arguments, WINDOW, ACTION and TYPES.
WINDOW is where the mouse is when the function is called. WINDOW may be a
@@ -412,19 +412,13 @@ FRAME is the frame and W is the window where the drop happened.
If W is a window, return its absolute coordinates,
otherwise return the frame coordinates."
(let* ((frame-left (frame-parameter frame 'left))
- ;; If the frame is outside the display, frame-left looks like
- ;; '(0 -16). Extract the -16.
- (frame-real-left (if (consp frame-left) (car (cdr frame-left))
- frame-left))
- (frame-top (frame-parameter frame 'top))
- (frame-real-top (if (consp frame-top) (car (cdr frame-top))
- frame-top)))
+ (frame-top (frame-parameter frame 'top)))
(if (windowp w)
(let ((edges (window-inside-pixel-edges w)))
(cons
- (+ frame-real-left (nth 0 edges))
- (+ frame-real-top (nth 1 edges))))
- (cons frame-real-left frame-real-top))))
+ (+ frame-left (nth 0 edges))
+ (+ frame-top (nth 1 edges))))
+ (cons frame-left frame-top))))
(declare-function x-get-atom-name "xselect.c" (value &optional frame))
(declare-function x-send-client-message "xselect.c"
@@ -434,15 +428,11 @@ otherwise return the frame coordinates."
(defun x-dnd-version-from-flags (flags)
"Return the version byte from the 32 bit FLAGS in an XDndEnter message."
- (if (consp flags) ;; Long as cons
- (ash (car flags) -8)
- (ash flags -24))) ;; Ordinary number
+ (ash flags -24))
(defun x-dnd-more-than-3-from-flags (flags)
"Return the nmore-than3 bit from the 32 bit FLAGS in an XDndEnter message."
- (if (consp flags)
- (logand (cdr flags) 1)
- (logand flags 1)))
+ (logand flags 1))
(defun x-dnd-handle-xdnd (event frame window message _format data)
"Receive one XDND event (client message) and send the appropriate reply.
@@ -454,7 +444,7 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
(version (x-dnd-version-from-flags flags))
(more-than-3 (x-dnd-more-than-3-from-flags flags))
(dnd-source (aref data 0)))
- (message "%s %s" version more-than-3)
+ (message "%s %s" version more-than-3)
(if version ;; If flags is bad, version will be nil.
(x-dnd-save-state
window nil nil
@@ -495,10 +485,12 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
((equal "XdndDrop" message)
(if (windowp window) (select-window window))
(let* ((dnd-source (aref data 0))
+ (timestamp (aref data 2))
(value (and (x-dnd-current-type window)
(x-get-selection-internal
'XdndSelection
- (intern (x-dnd-current-type window)))))
+ (intern (x-dnd-current-type window))
+ timestamp)))
success action)
(setq action (if value
@@ -545,14 +537,14 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
((eq size 4)
(if (eq byteorder ?l)
- (cons (+ (ash (aref data (+ 3 offset)) 8)
- (aref data (+ 2 offset)))
- (+ (ash (aref data (1+ offset)) 8)
- (aref data offset)))
- (cons (+ (ash (aref data offset) 8)
- (aref data (1+ offset)))
- (+ (ash (aref data (+ 2 offset)) 8)
- (aref data (+ 3 offset))))))))
+ (+ (ash (aref data (+ 3 offset)) 24)
+ (ash (aref data (+ 2 offset)) 16)
+ (ash (aref data (1+ offset)) 8)
+ (aref data offset))
+ (+ (ash (aref data offset) 24)
+ (ash (aref data (1+ offset)) 16)
+ (ash (aref data (+ 2 offset)) 8)
+ (aref data (+ 3 offset)))))))
(defun x-dnd-motif-value-to-list (value size byteorder)
(let ((bytes (cond ((eq size 2)
@@ -560,15 +552,10 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
(logand value ?\xff)))
((eq size 4)
- (if (consp value)
- (list (logand (ash (car value) -8) ?\xff)
- (logand (car value) ?\xff)
- (logand (ash (cdr value) -8) ?\xff)
- (logand (cdr value) ?\xff))
- (list (logand (ash value -24) ?\xff)
- (logand (ash value -16) ?\xff)
- (logand (ash value -8) ?\xff)
- (logand value ?\xff)))))))
+ (list (logand (ash value -24) ?\xff)
+ (logand (ash value -16) ?\xff)
+ (logand (ash value -8) ?\xff)
+ (logand value ?\xff))))))
(if (eq byteorder ?l)
(reverse bytes)
bytes)))
diff --git a/lisp/xml.el b/lisp/xml.el
index dc774a202cf..c96ff80446a 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -655,7 +655,7 @@ Leave point at the first non-blank character after the tag."
(setq name (xml-maybe-do-ns (match-string-no-properties 1) nil xml-ns))
(goto-char end-pos)
- ;; See also: http://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize
+ ;; See also: https://www.w3.org/TR/2000/REC-xml-20001006#AVNormalize
;; Do we have a string between quotes (or double-quotes),
;; or a simple word ?
@@ -1015,7 +1015,10 @@ The first line is indented with the optional INDENT-STRING."
(defalias 'xml-print 'xml-debug-print)
-(defun xml-escape-string (string)
+(defconst xml-invalid-characters-re
+ "[^\u0009\u000A\u000D\u0020-\uD7FF\uE000-\uFFFD\U00010000-\U0010FFFF]")
+
+(defun xml-escape-string (string &optional noerror)
"Convert STRING into a string containing valid XML character data.
Replace occurrences of &<>\\='\" in STRING with their default XML
entity references (e.g., replace each & with &amp;).
@@ -1023,9 +1026,20 @@ entity references (e.g., replace each & with &amp;).
XML character data must not contain & or < characters, nor the >
character under some circumstances. The XML spec does not impose
restriction on \" or \\=', but we just substitute for these too
-\(as is permitted by the spec)."
+\(as is permitted by the spec).
+
+If STRING contains characters that are invalid in XML (as defined
+by https://www.w3.org/TR/xml/#charsets), operate depending on the
+value of NOERROR: if it is non-nil, remove them; else, signal an
+error of type `xml-invalid-character'."
(with-temp-buffer
(insert string)
+ (goto-char (point-min))
+ (while (re-search-forward xml-invalid-characters-re nil t)
+ (if noerror
+ (replace-match "")
+ (signal 'xml-invalid-character
+ (list (char-before) (match-beginning 0)))))
(dolist (substitution '(("&" . "&amp;")
("<" . "&lt;")
(">" . "&gt;")
@@ -1036,6 +1050,9 @@ restriction on \" or \\=', but we just substitute for these too
(replace-match (cdr substitution) t t nil)))
(buffer-string)))
+(define-error 'xml-invalid-character "Invalid XML character"
+ 'wrong-type-argument)
+
(defun xml-debug-print-internal (xml indent-string)
"Outputs the XML tree in the current buffer.
The first line is indented with INDENT-STRING."
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 2b9fab556e0..9301476e815 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -76,7 +76,12 @@ https://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
;; to guard against that.
(copy-sequence event))
vec)
- (is-move vec)
+ (is-move
+ (xterm-mouse--handle-mouse-movement)
+ (if track-mouse vec
+ ;; Mouse movement events are currently supposed to be
+ ;; suppressed. Return no event.
+ []))
(t
(let* ((down (terminal-parameter nil 'xterm-mouse-last-down))
(down-data (nth 1 down))
@@ -102,8 +107,14 @@ https://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
(if (null track-mouse)
(vector drag)
(push drag unread-command-events)
+ (xterm-mouse--handle-mouse-movement)
(vector (list 'mouse-movement ev-data))))))))))))
+(defun xterm-mouse--handle-mouse-movement ()
+ "Handle mouse motion that was just generated for XTerm mouse."
+ (display--update-for-mouse-movement (terminal-parameter nil 'xterm-mouse-x)
+ (terminal-parameter nil 'xterm-mouse-y)))
+
;; These two variables have been converted to terminal parameters.
;;
;;(defvar xterm-mouse-x 0
@@ -237,7 +248,10 @@ which is the \"1006\" extension implemented in Xterm >= 277."
(xterm-mouse--read-event-sequence extension))
(t
(error "Unsupported XTerm mouse protocol")))))
- (when click
+ (when (and click
+ ;; In very obscure circumstances, the click may become
+ ;; invalid (see bug#17378).
+ (>= (nth 1 click) 0))
(let* ((type (nth 0 click))
(x (nth 1 click))
(y (nth 2 click))
@@ -260,7 +274,7 @@ which is the \"1006\" extension implemented in Xterm >= 277."
(eq y 1)))
'tab-bar
'menu-bar))
- (nthcdr 2 (posn-at-x-y x y)))))
+ (nthcdr 2 (posn-at-x-y x y (selected-frame))))))
(event (list type posn)))
(setcar (nthcdr 3 posn) timestamp)
@@ -318,11 +332,13 @@ down the SHIFT key while pressing the mouse button."
(if xterm-mouse-mode
;; Turn it on
(progn
- (setq mouse-position-function #'xterm-mouse-position-function)
+ (setq mouse-position-function #'xterm-mouse-position-function
+ tty-menu-calls-mouse-position-function t)
(mapc #'turn-on-xterm-mouse-tracking-on-terminal (terminal-list)))
;; Turn it off
(mapc #'turn-off-xterm-mouse-tracking-on-terminal (terminal-list))
- (setq mouse-position-function nil)))
+ (setq mouse-position-function nil
+ tty-menu-calls-mouse-position-function nil)))
(defun xterm-mouse-tracking-enable-sequence ()
"Return a control sequence to enable XTerm mouse tracking.
@@ -336,8 +352,8 @@ modern xterms:
position (<= 223), which can be reported in this
basic mode.
-\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse
- motion events during dragging operations.
+\"\\e[?1003h\" \"Mouse motion mode\": Enables reports for mouse
+ motion events.
\"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an
extension to the basic mouse mode, which uses UTF-8
@@ -357,7 +373,7 @@ given escape sequence takes precedence over the former."
(apply #'concat (xterm-mouse--tracking-sequence ?h)))
(defconst xterm-mouse-tracking-enable-sequence
- "\e[?1000h\e[?1002h\e[?1005h\e[?1006h"
+ "\e[?1000h\e[?1003h\e[?1005h\e[?1006h"
"Control sequence to enable xterm mouse tracking.
Enables basic mouse tracking, mouse motion events and finally
extended tracking on terminals that support it. The following
@@ -368,8 +384,8 @@ escape sequences are understood by modern xterms:
position (<= 223), which can be reported in this
basic mode.
-\"\\e[?1002h\" \"Mouse motion mode\": Enables reports for mouse
- motion events during dragging operations.
+\"\\e[?1003h\" \"Mouse motion mode\": Enables reports for mouse
+ motion events.
\"\\e[?1005h\" \"UTF-8 coordinate extension\": Enables an extension
to the basic mouse mode, which uses UTF-8
@@ -397,7 +413,7 @@ The control sequence resets the modes set by
(apply #'concat (nreverse (xterm-mouse--tracking-sequence ?l))))
(defconst xterm-mouse-tracking-disable-sequence
- "\e[?1006l\e[?1005l\e[?1002l\e[?1000l"
+ "\e[?1006l\e[?1005l\e[?1003l\e[?1000l"
"Reset the modes set by `xterm-mouse-tracking-enable-sequence'.")
(make-obsolete-variable
@@ -411,7 +427,7 @@ SUFFIX is the last character of each escape sequence (?h to
enable, ?l to disable)."
(mapcar
(lambda (code) (format "\e[?%d%c" code suffix))
- `(1000 1002 ,@(when xterm-mouse-utf-8 '(1005)) 1006)))
+ `(1000 1003 ,@(when xterm-mouse-utf-8 '(1005)) 1006)))
(defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal)
"Enable xterm mouse tracking on TERMINAL."
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index 775dddf8ef6..caf57ae43fe 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -41,7 +41,10 @@
(declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height))
(declare-function xwidget-webkit-execute-script "xwidget.c"
(xwidget script &optional callback))
+(declare-function xwidget-webkit-uri "xwidget.c" (xwidget))
+(declare-function xwidget-webkit-title "xwidget.c" (xwidget))
(declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri))
+(declare-function xwidget-webkit-goto-history "xwidget.c" (xwidget rel-pos))
(declare-function xwidget-webkit-zoom "xwidget.c" (xwidget factor))
(declare-function xwidget-plist "xwidget.c" (xwidget))
(declare-function set-xwidget-plist "xwidget.c" (xwidget plist))
@@ -51,6 +54,10 @@
(declare-function get-buffer-xwidgets "xwidget.c" (buffer))
(declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget))
+(defgroup xwidget nil
+ "Displaying native widgets in Emacs buffers."
+ :group 'widgets)
+
(defun xwidget-insert (pos type title width height &optional args)
"Insert an xwidget at position POS.
Supply the xwidget's TYPE, TITLE, WIDTH, and HEIGHT.
@@ -78,6 +85,8 @@ This returns the result of `make-xwidget'."
;;; webkit support
(require 'browse-url)
(require 'image-mode);;for some image-mode alike functionality
+(require 'seq)
+(require 'url-handlers)
;;;###autoload
(defun xwidget-webkit-browse-url (url &optional new-session)
@@ -92,10 +101,31 @@ Interactively, URL defaults to the string looking like a url around point."
(or (featurep 'xwidget-internal)
(user-error "Your Emacs was not compiled with xwidgets support"))
(when (stringp url)
+ ;; If it's a "naked url", just try adding https: to it.
+ (unless (string-match "\\`[A-Za-z]+:" url)
+ (setq url (concat "https://" url)))
(if new-session
(xwidget-webkit-new-session url)
(xwidget-webkit-goto-url url))))
+(defun xwidget-webkit-clone-and-split-below ()
+ "Clone current URL into a new widget place in new window below.
+Get the URL of current session, then browse to the URL
+in `split-window-below' with a new xwidget webkit session."
+ (interactive)
+ (let ((url (xwidget-webkit-current-url)))
+ (with-selected-window (split-window-below)
+ (xwidget-webkit-new-session url))))
+
+(defun xwidget-webkit-clone-and-split-right ()
+ "Clone current URL into a new widget place in new window right.
+Get the URL of current session, then browse to the URL
+in `split-window-right' with a new xwidget webkit session."
+ (interactive)
+ (let ((url (xwidget-webkit-current-url)))
+ (with-selected-window (split-window-right)
+ (xwidget-webkit-new-session url))))
+
;;todo.
;; - check that the webkit support is compiled in
(defvar xwidget-webkit-mode-map
@@ -103,6 +133,7 @@ Interactively, URL defaults to the string looking like a url around point."
(define-key map "g" 'xwidget-webkit-browse-url)
(define-key map "a" 'xwidget-webkit-adjust-size-dispatch)
(define-key map "b" 'xwidget-webkit-back)
+ (define-key map "f" 'xwidget-webkit-forward)
(define-key map "r" 'xwidget-webkit-reload)
(define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!?
(define-key map "\C-m" 'xwidget-webkit-insert-string)
@@ -112,20 +143,21 @@ Interactively, URL defaults to the string looking like a url around point."
;;similar to image mode bindings
(define-key map (kbd "SPC") 'xwidget-webkit-scroll-up)
+ (define-key map (kbd "S-SPC") 'xwidget-webkit-scroll-down)
(define-key map (kbd "DEL") 'xwidget-webkit-scroll-down)
- (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up)
+ (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up-line)
(define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up)
- (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down)
+ (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down-line)
(define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down)
(define-key map [remap forward-char] 'xwidget-webkit-scroll-forward)
(define-key map [remap backward-char] 'xwidget-webkit-scroll-backward)
(define-key map [remap right-char] 'xwidget-webkit-scroll-forward)
(define-key map [remap left-char] 'xwidget-webkit-scroll-backward)
- (define-key map [remap previous-line] 'xwidget-webkit-scroll-down)
- (define-key map [remap next-line] 'xwidget-webkit-scroll-up)
+ (define-key map [remap previous-line] 'xwidget-webkit-scroll-down-line)
+ (define-key map [remap next-line] 'xwidget-webkit-scroll-up-line)
;; (define-key map [remap move-beginning-of-line] 'image-bol)
;; (define-key map [remap move-end-of-line] 'image-eol)
@@ -144,33 +176,63 @@ Interactively, URL defaults to the string looking like a url around point."
(interactive)
(xwidget-webkit-zoom (xwidget-webkit-current-session) -0.1))
-(defun xwidget-webkit-scroll-up ()
- "Scroll webkit up."
- (interactive)
+(defun xwidget-webkit-scroll-up (&optional arg)
+ "Scroll webkit up by ARG pixels; or full window height if no ARG.
+Stop if bottom of page is reached.
+Interactively, ARG is the prefix numeric argument.
+Negative ARG scrolls down."
+ (interactive "P")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(0, 50);"))
-
-(defun xwidget-webkit-scroll-down ()
- "Scroll webkit down."
- (interactive)
+ (format "window.scrollBy(0, %d);"
+ (or arg (xwidget-window-inside-pixel-height (selected-window))))))
+
+(defun xwidget-webkit-scroll-down (&optional arg)
+ "Scroll webkit down by ARG pixels; or full window height if no ARG.
+Stop if top of page is reached.
+Interactively, ARG is the prefix numeric argument.
+Negative ARG scrolls up."
+ (interactive "P")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(0, -50);"))
-
-(defun xwidget-webkit-scroll-forward ()
- "Scroll webkit forwards."
- (interactive)
+ (format "window.scrollBy(0, -%d);"
+ (or arg (xwidget-window-inside-pixel-height (selected-window))))))
+
+(defun xwidget-webkit-scroll-up-line (&optional n)
+ "Scroll webkit up by N lines.
+The height of line is calculated with `window-font-height'.
+Stop if the bottom edge of the page is reached.
+If N is omitted or nil, scroll up by one line."
+ (interactive "p")
+ (xwidget-webkit-scroll-up (* n (window-font-height))))
+
+(defun xwidget-webkit-scroll-down-line (&optional n)
+ "Scroll webkit down by N lines.
+The height of line is calculated with `window-font-height'.
+Stop if the top edge of the page is reached.
+If N is omitted or nil, scroll down by one line."
+ (interactive "p")
+ (xwidget-webkit-scroll-down (* n (window-font-height))))
+
+(defun xwidget-webkit-scroll-forward (&optional n)
+ "Scroll webkit horizontally by N chars.
+The width of char is calculated with `window-font-width'.
+If N is omitted or nil, scroll forwards by one char."
+ (interactive "p")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(50, 0);"))
-
-(defun xwidget-webkit-scroll-backward ()
- "Scroll webkit backwards."
- (interactive)
+ (format "window.scrollBy(%d, 0);"
+ (* n (window-font-width)))))
+
+(defun xwidget-webkit-scroll-backward (&optional n)
+ "Scroll webkit back by N chars.
+The width of char is calculated with `window-font-width'.
+If N is omitted or nil, scroll backwards by one char."
+ (interactive "p")
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollBy(-50, 0);"))
+ (format "window.scrollBy(-%d, 0);"
+ (* n (window-font-width)))))
(defun xwidget-webkit-scroll-top ()
"Scroll webkit to the very top."
@@ -184,7 +246,7 @@ Interactively, URL defaults to the string looking like a url around point."
(interactive)
(xwidget-webkit-execute-script
(xwidget-webkit-current-session)
- "window.scrollTo(pageXOffset, window.document.body.clientHeight);"))
+ "window.scrollTo(pageXOffset, window.document.body.scrollHeight);"))
;; The xwidget event needs to go into a higher level handler
;; since the xwidget can generate an event even if it's offscreen.
@@ -204,12 +266,8 @@ Interactively, URL defaults to the string looking like a url around point."
(let*
((xwidget-event-type (nth 1 last-input-event))
(xwidget (nth 2 last-input-event))
- ;;(xwidget-callback (xwidget-get xwidget 'callback))
- ;;TODO stopped working for some reason
- )
- ;;(funcall xwidget-callback xwidget xwidget-event-type)
- (message "xw callback %s" xwidget)
- (funcall 'xwidget-webkit-callback xwidget xwidget-event-type)))
+ (xwidget-callback (xwidget-get xwidget 'callback)))
+ (funcall xwidget-callback xwidget xwidget-event-type)))
(defun xwidget-webkit-callback (xwidget xwidget-event-type)
"Callback for xwidgets.
@@ -219,21 +277,23 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
"error: callback called for xwidget with dead buffer")
(with-current-buffer (xwidget-buffer xwidget)
(cond ((eq xwidget-event-type 'load-changed)
- (xwidget-webkit-execute-script
- xwidget "document.title"
- (lambda (title)
- (xwidget-log "webkit finished loading: '%s'" title)
- ;;TODO - check the native/internal scroll
- ;;(xwidget-adjust-size-to-content xwidget)
- (xwidget-webkit-adjust-size-to-window xwidget)
- (rename-buffer (format "*xwidget webkit: %s *" title))))
- (pop-to-buffer (current-buffer)))
+ (let ((title (xwidget-webkit-title xwidget)))
+ (xwidget-log "webkit finished loading: %s" title)
+ ;; Do not adjust webkit size to window here, the selected window
+ ;; can be the mini-buffer window unwantedly.
+ (rename-buffer (format "*xwidget webkit: %s *" title) t)))
((eq xwidget-event-type 'decide-policy)
(let ((strarg (nth 3 last-input-event)))
(if (string-match ".*#\\(.*\\)" strarg)
(xwidget-webkit-show-id-or-named-element
xwidget
(match-string 1 strarg)))))
+ ;; TODO: Response handling other than download.
+ ((eq xwidget-event-type 'download-callback)
+ (let ((url (nth 3 last-input-event))
+ (mime-type (nth 4 last-input-event))
+ (file-name (nth 5 last-input-event)))
+ (xwidget-webkit-save-as-file url mime-type file-name)))
((eq xwidget-event-type 'javascript-callback)
(let ((proc (nth 3 last-input-event))
(arg (nth 4 last-input-event)))
@@ -241,21 +301,66 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
(t (xwidget-log "unhandled event:%s" xwidget-event-type))))))
(defvar bookmark-make-record-function)
+(when (memq window-system '(mac ns))
+ (defvar xwidget-webkit-enable-plugins nil
+ "Enable plugins for xwidget webkit.
+If non-nil, plugins are enabled. Otherwise, disabled."))
+
(define-derived-mode xwidget-webkit-mode
- special-mode "xwidget-webkit" "Xwidget webkit view mode."
- (setq buffer-read-only t)
- (setq-local bookmark-make-record-function
- #'xwidget-webkit-bookmark-make-record)
- ;; Keep track of [vh]scroll when switching buffers
- (image-mode-setup-winprops))
+ special-mode "xwidget-webkit" "Xwidget webkit view mode."
+ (setq buffer-read-only t)
+ (setq-local bookmark-make-record-function
+ #'xwidget-webkit-bookmark-make-record)
+ ;; Keep track of [vh]scroll when switching buffers
+ (image-mode-setup-winprops))
+
+;;; Download, save as file.
+
+(defcustom xwidget-webkit-download-dir "~/Downloads/"
+ "Directory where download file saved."
+ :version "28.1"
+ :type 'file)
+
+(defun xwidget-webkit-save-as-file (url mime-type file-name)
+ "For XWIDGET webkit, save URL of MIME-TYPE to location specified by user.
+FILE-NAME combined with `xwidget-webkit-download-dir' is the default file name
+of the prompt when reading. When the file name the user specified is a
+directory, URL is saved at the specified directory as FILE-NAME."
+ (let ((save-name (read-file-name
+ (format "Save URL `%s' of type `%s' in file/directory: "
+ url mime-type)
+ xwidget-webkit-download-dir
+ (when file-name
+ (expand-file-name
+ file-name
+ xwidget-webkit-download-dir)))))
+ (if (file-directory-p save-name)
+ (setq save-name
+ (expand-file-name (file-name-nondirectory file-name) save-name)))
+ (setq xwidget-webkit-download-dir (file-name-directory save-name))
+ (url-copy-file url save-name t)))
+
+;;; Bookmarks integration
+
+(defcustom xwidget-webkit-bookmark-jump-new-session nil
+ "Control bookmark jump to use new session or not.
+If non-nil, use a new xwidget webkit session after bookmark jump.
+Otherwise, it will use `xwidget-webkit-last-session'.
+When you set this variable to nil, consider further customization with
+`xwidget-webkit-last-session-buffer'."
+ :version "28.1"
+ :type 'boolean)
(defun xwidget-webkit-bookmark-make-record ()
- "Integrate Emacs bookmarks with the webkit xwidget."
+ "Create bookmark record in webkit xwidget."
(nconc (bookmark-make-record-default t t)
- `((page . ,(xwidget-webkit-current-url))
- (handler . (lambda (bmk) (browse-url
- (bookmark-prop-get bmk 'page)))))))
+ `((page . ,(xwidget-webkit-uri (xwidget-webkit-current-session)))
+ (handler . (lambda (bmk)
+ (xwidget-webkit-browse-url
+ (bookmark-prop-get bmk 'page)
+ xwidget-webkit-bookmark-jump-new-session))))))
+;;; xwidget webkit session
(defvar xwidget-webkit-last-session-buffer nil)
@@ -303,7 +408,7 @@ function findactiveelement(doc){
"
- "javascript that finds the active element."
+ "Javascript that finds the active element."
;; Yes it's ugly, because:
;; - there is apparently no way to find the active frame other than recursion
;; - the js "for each" construct misbehaved on the "frames" collection
@@ -313,19 +418,22 @@ function findactiveelement(doc){
)
(defun xwidget-webkit-insert-string ()
- "Prompt for a string and insert it in the active field in the
-current webkit widget."
+ "Insert string into the active field in the current webkit widget."
;; Read out the string in the field first and provide for edit.
(interactive)
+ ;; As the prompt differs on JavaScript execution results,
+ ;; the function must handle the prompt itself.
(let ((xww (xwidget-webkit-current-session)))
(xwidget-webkit-execute-script
xww
(concat xwidget-webkit-activeelement-js "
(function () {
var res = findactiveelement(document);
- return [res.value, res.type];
+ if (res)
+ return [res.value, res.type];
})();")
(lambda (field)
+ "Prompt a string for the FIELD and insert in the active input."
(let ((str (pcase field
(`[,val "text"]
(read-string "Text: " val))
@@ -444,11 +552,23 @@ For example, use this to display an anchor."
(ignore-errors
(recenter-top-bottom)))
+;; Utility functions
+
+(defun xwidget-window-inside-pixel-width (window)
+ "Return Emacs WINDOW body width in pixel."
+ (let ((edges (window-inside-pixel-edges window)))
+ (- (nth 2 edges) (nth 0 edges))))
+
+(defun xwidget-window-inside-pixel-height (window)
+ "Return Emacs WINDOW body height in pixel."
+ (let ((edges (window-inside-pixel-edges window)))
+ (- (nth 3 edges) (nth 1 edges))))
+
(defun xwidget-webkit-adjust-size-to-window (xwidget &optional window)
"Adjust the size of the webkit XWIDGET to fit the WINDOW."
(xwidget-resize xwidget
- (window-pixel-width window)
- (window-pixel-height window)))
+ (xwidget-window-inside-pixel-width window)
+ (xwidget-window-inside-pixel-height window)))
(defun xwidget-webkit-adjust-size (w h)
"Manually set webkit size to width W, height H."
@@ -478,51 +598,56 @@ For example, use this to display an anchor."
(add-to-list 'window-size-change-functions
'xwidget-webkit-adjust-size-in-frame))
-(defun xwidget-webkit-new-session (url)
+(defun xwidget-webkit-new-session (url &optional callback)
"Create a new webkit session buffer with URL."
(let*
((bufname (generate-new-buffer-name "*xwidget-webkit*"))
+ (callback (or callback #'xwidget-webkit-callback))
xw)
(setq xwidget-webkit-last-session-buffer (switch-to-buffer
(get-buffer-create bufname)))
;; The xwidget id is stored in a text property, so we need to have
;; at least character in this buffer.
- (insert " ")
- (setq xw (xwidget-insert 1 'webkit bufname
- (window-pixel-width)
- (window-pixel-height)))
- (xwidget-put xw 'callback 'xwidget-webkit-callback)
+ ;; Insert invisible url, good default for next `g' to browse url.
+ (let ((start (point)))
+ (insert url)
+ (put-text-property start (+ start (length url)) 'invisible t)
+ (setq xw (xwidget-insert
+ start 'webkit bufname
+ (xwidget-window-inside-pixel-width (selected-window))
+ (xwidget-window-inside-pixel-height (selected-window)))))
+ (xwidget-put xw 'callback callback)
(xwidget-webkit-mode)
(xwidget-webkit-goto-uri (xwidget-webkit-last-session) url)))
(defun xwidget-webkit-goto-url (url)
- "Goto URL."
+ "Goto URL with xwidget webkit."
(if (xwidget-webkit-current-session)
(progn
(xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
(xwidget-webkit-new-session url)))
(defun xwidget-webkit-back ()
- "Go back in history."
+ "Go back to previous URL in xwidget webkit buffer."
(interactive)
- (xwidget-webkit-execute-script (xwidget-webkit-current-session)
- "history.go(-1);"))
+ (xwidget-webkit-goto-history (xwidget-webkit-current-session) -1))
+
+(defun xwidget-webkit-forward ()
+ "Go forward in history."
+ (interactive)
+ (xwidget-webkit-goto-history (xwidget-webkit-current-session) 1))
(defun xwidget-webkit-reload ()
- "Reload current url."
+ "Reload current URL."
(interactive)
- (xwidget-webkit-execute-script (xwidget-webkit-current-session)
- "history.go(0);"))
+ (xwidget-webkit-goto-history (xwidget-webkit-current-session) 0))
(defun xwidget-webkit-current-url ()
- "Get the webkit url and place it on the kill-ring."
+ "Display the current xwidget webkit URL and place it on the `kill-ring'."
(interactive)
- (xwidget-webkit-execute-script
- (xwidget-webkit-current-session)
- "document.URL" (lambda (rv)
- (let ((url (kill-new (or rv ""))))
- (message "url: %s" url)))))
+ (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session))))
+ (message "URL: %s" (kill-new (or url "")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xwidget-webkit-get-selection (proc)
@@ -533,10 +658,9 @@ For example, use this to display an anchor."
proc))
(defun xwidget-webkit-copy-selection-as-kill ()
- "Get the webkit selection and put it on the kill-ring."
+ "Get the webkit selection and put it on the `kill-ring'."
(interactive)
- (xwidget-webkit-get-selection (lambda (selection) (kill-new selection))))
-
+ (xwidget-webkit-get-selection #'kill-new))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Xwidget plist management (similar to the process plist functions)